diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index c06731c..7b63de3 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/lib/Database/PostgreSQL/Opium/FromField.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} module Database.PostgreSQL.Opium.FromField @@ -8,13 +9,18 @@ module Database.PostgreSQL.Opium.FromField 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 @@ -47,11 +53,6 @@ fromParser validOid parser oid field class FromField a where fromField :: Oid -> Text -> Either FieldError a -instance FromField Int where - fromField = fromParser - (Oid.smallint \/ Oid.integer \/ Oid.bigint) - (signed decimal) - instance FromField Text where fromField = fromParser (Oid.text \/ Oid.character \/ Oid.characterVarying) @@ -59,3 +60,28 @@ instance FromField Text where 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 diff --git a/lib/Database/PostgreSQL/Opium/Oid.hs b/lib/Database/PostgreSQL/Opium/Oid.hs index f16b78d..86a3659 100644 --- a/lib/Database/PostgreSQL/Opium/Oid.hs +++ b/lib/Database/PostgreSQL/Opium/Oid.hs @@ -5,6 +5,17 @@ import Database.PostgreSQL.LibPQ (Oid (..)) eq :: Eq a => a -> a -> Bool eq = (==) +-- string types + +text :: Oid -> Bool +text = eq $ Oid 25 + +character :: Oid -> Bool +character = eq $ Oid 1042 + +characterVarying :: Oid -> Bool +characterVarying = eq $ Oid 1043 + -- integer types -- | 16-bit integer @@ -19,13 +30,12 @@ integer = eq $ Oid 23 bigint :: Oid -> Bool bigint = eq $ Oid 20 --- string types +-- floating point types -text :: Oid -> Bool -text = eq $ Oid 25 +-- | 32-bit IEEE float +real :: Oid -> Bool +real = eq $ Oid 700 -character :: Oid -> Bool -character = eq $ Oid 1042 - -characterVarying :: Oid -> Bool -characterVarying = eq $ Oid 1043 +-- | 64-bit IEEE float +doublePrecision :: Oid -> Bool +doublePrecision = eq $ Oid 701 diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index c3d4d97..150a68e 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs @@ -8,63 +8,120 @@ import Data.Text (Text) import Database.PostgreSQL.LibPQ (Connection) import Database.PostgreSQL.Opium (FromRow) import GHC.Generics (Generic) -import Test.Hspec (SpecWith, describe, it, shouldBe) +import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy) import qualified Database.PostgreSQL.Opium as Opium -newtype SingleInt = SingleInt +newtype AnInt = AnInt { int :: Int } deriving (Eq, Generic, Show) -instance FromRow SingleInt where +instance FromRow AnInt where -newtype SingleText = SingleText +newtype AText = AText { text :: Text } deriving (Eq, Generic, Show) -instance FromRow SingleText where +instance FromRow AText where -newtype SingleString = SingleString +newtype AString = AString { string :: String } deriving (Eq, Generic, Show) -instance FromRow SingleString where +instance FromRow AString where + +newtype AFloat = AFloat + { float :: Float + } deriving (Eq, Generic, Show) + +instance FromRow AFloat + +newtype ADouble = ADouble + { double :: Double + } deriving (Eq, Generic, Show) + +instance FromRow ADouble where shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO () shouldFetch conn query expectedRows = do actualRows <- Opium.fetch_ conn query actualRows `shouldBe` Right expectedRows +(/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool +p /\ q = \x -> p x && q x + spec :: SpecWith Connection spec = do describe "FromField Int" $ do it "Decodes smallint" $ \conn -> do - shouldFetch conn "SELECT 42::SMALLINT AS int" [SingleInt 42] + shouldFetch conn "SELECT 42::SMALLINT AS int" [AnInt 42] it "Decodes integer" $ \conn -> do - shouldFetch conn "SELECT 42::INTEGER AS int" [SingleInt 42] + shouldFetch conn "SELECT 42::INTEGER AS int" [AnInt 42] it "Decodes bigint" $ \conn -> do - shouldFetch conn "SELECT 42::BIGINT AS int" [SingleInt 42] + shouldFetch conn "SELECT 42::BIGINT AS int" [AnInt 42] describe "FromField Text" $ do it "Decodes text" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [SingleText "Hello, World!"] + shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"] it "Decodes character" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [SingleText "Hello, Wor"] - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [SingleText "Hello, World! "] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [AText "Hello, Wor"] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [AText "Hello, World! "] it "Decodes character varying" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [SingleText "Hello, World!"] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [AText "Hello, World!"] describe "FromField String" $ do it "Decodes text" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [SingleString "Hello, World!"] + shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [AString "Hello, World!"] it "Decodes character" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [SingleString "Hello, Wor"] - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [SingleString "Hello, World! "] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [AString "Hello, Wor"] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [AString "Hello, World! "] it "Decodes character varying" $ \conn -> do - shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [SingleString "Hello, World!"] + shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [AString "Hello, World!"] + + describe "FromField Float" $ do + it "Decodes real" $ \conn -> do + shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2] + + it "Decodes NaN::real" $ \conn -> do + Right [AFloat value] <- Opium.fetch_ conn "SELECT 'NaN'::real AS float" + value `shouldSatisfy` isNaN + + it "Decodes Infinity::real" $ \conn -> do + Right [AFloat value] <- Opium.fetch_ conn "SELECT 'Infinity'::real AS float" + value `shouldSatisfy` (isInfinite /\ (> 0)) + + it "Decodes -Infinity::real" $ \conn -> do + Right [AFloat value] <- Opium.fetch_ conn "SELECT '-Infinity'::real AS float" + value `shouldSatisfy` (isInfinite /\ (< 0)) + + describe "FromField Double" $ do + it "Decodes double precision" $ \conn -> do + shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2] + + it "Decodes real" $ \conn -> do + shouldFetch conn "SELECT 4.2::real AS double" [ADouble 4.2] + + it "Decodes NaN::double precision" $ \conn -> do + Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double" + value `shouldSatisfy` isNaN + + it "Decodes Infinity::double precision" $ \conn -> do + Right [ADouble value] <- Opium.fetch_ conn "SELECT 'Infinity'::double precision AS double" + value `shouldSatisfy` (isInfinite /\ (> 0)) + + it "Decodes -Infinity::double precision" $ \conn -> do + Right [ADouble value] <- Opium.fetch_ conn "SELECT '-Infinity'::double precision AS double" + value `shouldSatisfy` (isInfinite /\ (< 0)) + + it "Decodes {inf,-inf}::double precision" $ \conn -> do + Right [ADouble value0] <- Opium.fetch_ conn "SELECT 'inf'::double precision AS double" + value0 `shouldSatisfy` (isInfinite /\ (> 0)) + + Right [ADouble value1] <- Opium.fetch_ conn "SELECT '-inf'::double precision AS double" + value1 `shouldSatisfy` (isInfinite /\ (< 0))