Implement FromField Float and FromField Double

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

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