100 lines
2.2 KiB
Haskell
100 lines
2.2 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Database.PostgreSQL.Opium.FromField
|
|
( FieldError (..)
|
|
, FromField (..)
|
|
) where
|
|
|
|
import Data.Attoparsec.Text
|
|
( Parser
|
|
, choice
|
|
, decimal
|
|
, double
|
|
, parseOnly
|
|
, signed
|
|
, string
|
|
, takeText
|
|
)
|
|
import Data.Functor (($>))
|
|
import Data.Text (Text)
|
|
import Database.PostgreSQL.LibPQ (Oid)
|
|
import GHC.Float (double2Float)
|
|
|
|
import qualified Data.Text as Text
|
|
import qualified Database.PostgreSQL.Opium.Oid as Oid
|
|
|
|
(\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
|
|
p \/ q = \x -> p x || q x
|
|
|
|
data FieldError
|
|
= FieldErrorUnexpectedNull
|
|
| FieldErrorInvalidOid Oid
|
|
| FieldErrorInvalidField Oid Text String
|
|
deriving (Eq, Show)
|
|
|
|
mapLeft :: (b -> c) -> Either b a -> Either c a
|
|
mapLeft f (Left l) = Left $ f l
|
|
mapLeft _ (Right r) = Right r
|
|
|
|
fromParser
|
|
:: (Oid -> Bool)
|
|
-> Parser a
|
|
-> Oid
|
|
-> Text
|
|
-> Either FieldError a
|
|
fromParser validOid parser oid field
|
|
| validOid oid =
|
|
mapLeft (FieldErrorInvalidField oid field) $ parseOnly parser field
|
|
| otherwise =
|
|
Left $ FieldErrorInvalidOid oid
|
|
|
|
class FromField a where
|
|
fromField :: Oid -> Text -> Either FieldError a
|
|
|
|
instance FromField Text where
|
|
fromField = fromParser
|
|
(Oid.text \/ Oid.character \/ Oid.characterVarying)
|
|
takeText
|
|
|
|
instance FromField String where
|
|
fromField oid text = Text.unpack <$> fromField oid text
|
|
|
|
instance FromField Int where
|
|
fromField = fromParser
|
|
(Oid.smallint \/ Oid.integer \/ Oid.bigint)
|
|
(signed decimal)
|
|
|
|
floatParser :: Parser Double
|
|
floatParser = choice
|
|
[ string "NaN" $> nan
|
|
, signed (string "Infinity" $> infinity)
|
|
, double
|
|
]
|
|
where
|
|
nan = 0 / 0
|
|
infinity = 1 / 0
|
|
|
|
instance FromField Float where
|
|
fromField = fromParser
|
|
Oid.real
|
|
(fmap double2Float floatParser)
|
|
|
|
instance FromField Double where
|
|
fromField = fromParser
|
|
(Oid.real \/ Oid.doublePrecision)
|
|
floatParser
|
|
|
|
boolParser :: Parser Bool
|
|
boolParser = choice
|
|
[ string "t" $> True
|
|
, string "f" $> False
|
|
]
|
|
|
|
-- | See https://www.postgresql.org/docs/current/datatype-boolean.html.
|
|
instance FromField Bool where
|
|
fromField = fromParser
|
|
Oid.boolean
|
|
boolParser
|