Implement FromField Float and FromField Double

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))