81 lines
1.8 KiB
Haskell
81 lines
1.8 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Database.PostgreSQL.Opium.FromField
|
|
( FromField (..)
|
|
, fromField
|
|
) where
|
|
|
|
import Data.Attoparsec.Text
|
|
( Parser
|
|
, choice
|
|
, decimal
|
|
, double
|
|
, parseOnly
|
|
, signed
|
|
, string
|
|
, takeText
|
|
)
|
|
import Data.Functor (($>))
|
|
import Data.Proxy (Proxy (..))
|
|
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
|
|
|
|
fromField :: FromField a => Text -> Either String a
|
|
fromField =
|
|
parseOnly parseField
|
|
|
|
class FromField a where
|
|
validOid :: Proxy a -> Oid -> Bool
|
|
parseField :: Parser a
|
|
|
|
instance FromField Text where
|
|
validOid _ = Oid.text \/ Oid.character \/ Oid.characterVarying
|
|
parseField = takeText
|
|
|
|
instance FromField String where
|
|
validOid _ = validOid @Text Proxy
|
|
parseField = Text.unpack <$> parseField
|
|
|
|
instance FromField Int where
|
|
validOid _ = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
|
parseField = signed decimal
|
|
|
|
doubleParser :: Parser Double
|
|
doubleParser = choice
|
|
[ string "NaN" $> nan
|
|
, signed (string "Infinity" $> infinity)
|
|
, double
|
|
]
|
|
where
|
|
nan = 0 / 0
|
|
infinity = 1 / 0
|
|
|
|
instance FromField Float where
|
|
validOid _ = Oid.real
|
|
parseField = fmap double2Float doubleParser
|
|
|
|
instance FromField Double where
|
|
validOid _ = Oid.real \/ Oid.doublePrecision
|
|
parseField = doubleParser
|
|
|
|
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
|
|
validOid _ = Oid.boolean
|
|
parseField = boolParser
|