diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index d673597..e723b78 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/lib/Database/PostgreSQL/Opium/FromField.hs @@ -9,6 +9,7 @@ module Database.PostgreSQL.Opium.FromField import Data.Attoparsec.Text ( Parser + , anyChar , choice , decimal , double @@ -38,14 +39,22 @@ class FromField a where validOid :: Proxy a -> Oid -> Bool parseField :: Parser a +-- | See https://www.postgresql.org/docs/current/datatype-character.html. instance FromField Text where validOid _ = Oid.text \/ Oid.character \/ Oid.characterVarying parseField = takeText +-- | See https://www.postgresql.org/docs/current/datatype-character.html. instance FromField String where validOid _ = validOid @Text Proxy parseField = Text.unpack <$> parseField +-- | See https://www.postgresql.org/docs/current/datatype-character.html. +-- This instance accepts all character types but fails to decode fields that are not exactly one character. +instance FromField Char where + validOid _ = validOid @Text Proxy + parseField = anyChar + instance FromField Int where validOid _ = Oid.smallint \/ Oid.integer \/ Oid.bigint parseField = signed decimal diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index 5a2968d..74b50ec 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs @@ -30,6 +30,12 @@ newtype AString = AString instance FromRow AString where +newtype AChar = AChar + { char :: Char + } deriving (Eq, Generic, Show) + +instance FromRow AChar where + newtype AFloat = AFloat { float :: Float } deriving (Eq, Generic, Show) @@ -90,6 +96,17 @@ spec = do it "Decodes character varying" $ \conn -> do shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [AString "Hello, World!"] + describe "FromField Char" $ do + it "Decodes text" $ \conn -> do + shouldFetch conn "SELECT 'X'::TEXT AS char" [AChar 'X'] + + it "Decodes character" $ \conn -> do + shouldFetch conn "SELECT 'XYZ'::CHARACTER(1) AS char" [AChar 'X'] + shouldFetch conn "SELECT ''::CHARACTER(1) AS char" [AChar ' '] + + it "Decodes character varying" $ \conn -> do + shouldFetch conn "SELECT 'X'::CHARACTER VARYING (20) AS char" [AChar 'X'] + describe "FromField Float" $ do it "Decodes real" $ \conn -> do shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2]