Decode values from binary instead of text format

README.md

@@ -62,10 +62,11 @@ getScoreByAge conn = do
 - [x] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe`
 - [x] Implement `Float` and `Double` decoding
 - [x] Clean up and document column table stuff
+- [x] Decode `LibPQ.Binary`
 - [ ] Implement `fetch` (`fetch_` but with parameter passing)
 - [ ] Implement `UTCTime` and zoned time decoding
 - [ ] Implement JSON decoding
 - [ ] Implement `ByteString` decoding (`bytea`)
-  - Can we make the fromField instance choose whether it wants binary or text?
 - [ ] Implement (anonymous) composite types
-  - It seems that in order to decode these, we'd need to use binary mode. In order to avoid writing everything twice it would be wise to move the whole `FromField` machinery to decoding from binary first
+- [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
+- [ ] Implement array decoding

lib/Database/PostgreSQL/Opium.hs

@@ -47,7 +47,7 @@ import Database.PostgreSQL.Opium.FromField (FromField (..), fromField)
 
 execParams :: Connection -> ByteString -> ExceptT Error IO Result
 execParams conn query = do
-  liftIO (LibPQ.execParams conn query [] LibPQ.Text) >>= \case
+  liftIO (LibPQ.execParams conn query [] LibPQ.Binary) >>= \case
     Nothing ->
       except $ Left ErrorNoResult
     Just result -> do
@@ -147,20 +147,16 @@ decodeField nameText g (FromRowCtx result columnTable iRef) row = do
   i <- liftIO $ readIORef iRef
   liftIO $ modifyIORef' iRef (+1)
   let (column, oid) = columnTable `indexColumnTable` i
-  mbField <- liftIO $ getFieldText column
+  mbField <- liftIO $ LibPQ.getvalue result row column
   mbValue <- except $ getValue oid mbField
   value <- except $ g row mbValue
   pure $ M1 $ K1 value
   where
-    getFieldText :: Column -> IO (Maybe Text)
+    getValue :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
-    getFieldText column = 
+    getValue oid = maybe (Right Nothing) $ \field ->
-      fmap Encoding.decodeUtf8 <$> LibPQ.getvalue result row column
-
-    getValue :: FromField u => LibPQ.Oid -> Maybe Text -> Either Error (Maybe u)
-    getValue oid = maybe (Right Nothing) $ \fieldText ->
       mapLeft
-        (ErrorInvalidField (ErrorPosition row nameText) oid fieldText)
+        (ErrorInvalidField (ErrorPosition row nameText) oid field)
-        (Just <$> fromField fieldText)
+        (Just <$> fromField field)
 
 mapLeft :: (b -> c) -> Either b a -> Either c a
 mapLeft f (Left l) = Left $ f l

lib/Database/PostgreSQL/Opium/Error.hs

@@ -1,6 +1,7 @@
 module Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) where
 
 import Control.Exception (Exception)
+import Data.ByteString (ByteString)
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row)
 
@@ -15,7 +16,7 @@ data Error
   | ErrorMissingColumn Text
   | ErrorInvalidOid Text Oid
   | ErrorUnexpectedNull ErrorPosition
-  | ErrorInvalidField ErrorPosition Oid Text String
+  | ErrorInvalidField ErrorPosition Oid ByteString String
   deriving (Eq, Show)
 
 instance Exception Error where

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -7,42 +7,42 @@ module Database.PostgreSQL.Opium.FromField
   , fromField
   ) where
 
-import Data.Attoparsec.Text
+import Data.Attoparsec.ByteString (Parser)
-  ( Parser
+import Data.Bits (Bits (..))
-  , anyChar
+import Data.ByteString (ByteString)
-  , choice
-  , decimal
-  , double
-  , parseOnly
-  , signed
-  , string
-  , takeText
-  )
 import Data.Functor (($>))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
+import Data.Word (Word32, Word64)
 import Database.PostgreSQL.LibPQ (Oid)
-import GHC.Float (double2Float)
+import Unsafe.Coerce (unsafeCoerce)
 
+import qualified Data.Attoparsec.ByteString as AP
+import qualified Data.ByteString as BS
 import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Encoding
 
 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 :: FromField a => ByteString -> Either String a
 fromField =
-  parseOnly parseField
+  AP.parseOnly parseField
 
 class FromField a where
   validOid :: Proxy a -> Oid -> Bool
   parseField :: Parser a
 
+instance FromField ByteString where
+  validOid Proxy = Oid.bytea
+  parseField = AP.takeByteString
+
 -- | See https://www.postgresql.org/docs/current/datatype-character.html.
 instance FromField Text where
   validOid Proxy = Oid.text \/ Oid.character \/ Oid.characterVarying
-  parseField = takeText
+  parseField = Encoding.decodeUtf8 <$> AP.takeByteString
 
 -- | See https://www.postgresql.org/docs/current/datatype-character.html.
 instance FromField String where
@@ -53,45 +53,54 @@ instance FromField String where
 -- This instance accepts all character types but fails to decode fields that are not exactly one character.
 instance FromField Char where
   validOid Proxy = validOid @Text Proxy
-  parseField = anyChar
+  parseField = do
+    str <- parseField
+    case str of
+      [c] -> pure c
+      _ -> fail "Char accepts single characters only"
+
+intParser :: (Bits a, Num a) => Parser a
+intParser = readBigEndian <$> AP.takeByteString
+  where
+    readBigEndian = BS.foldl' (\x b -> x `shiftL` 8 .|. fromIntegral b) 0
 
 -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
 -- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
 instance FromField Int where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = signed decimal
+  parseField = intParser
 
 -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
 instance FromField Integer where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = signed decimal
+  parseField = intParser
 
 instance FromField Word where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = decimal
+  parseField = intParser
-
-doubleParser :: Parser Double
-doubleParser = choice
-  [ string "NaN" $> nan
-  , signed (string "Infinity" $> infinity)
-  , double
-  ]
-  where
-    nan = 0 / 0
-    infinity = 1 / 0
 
+-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
+-- Accepts only @real@ fields, not @double precision@.
 instance FromField Float where
   validOid Proxy = Oid.real
-  parseField = fmap double2Float doubleParser
+  -- Afaict there's no cleaner (@base@) way to access the underlying bits.
+  -- In C we'd do
+  --
+  -- union { float a; uint32_t b; } x;
+  -- x.b = ...;
+  -- return x.a;
+  parseField = unsafeCoerce <$> intParser @Word32
 
+-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
+-- Accepts only @double precision@ fields, not @real@.
 instance FromField Double where
-  validOid Proxy = Oid.real \/ Oid.doublePrecision
+  validOid Proxy = Oid.doublePrecision
-  parseField = doubleParser
+  parseField = unsafeCoerce <$> intParser @Word64
 
 boolParser :: Parser Bool
-boolParser = choice
+boolParser = AP.choice
-  [ string "t" $> True
+  [ AP.word8 1 $> True
-  , string "f" $> False
+  , AP.word8 0 $> False
   ]
 
 -- | See https://www.postgresql.org/docs/current/datatype-boolean.html.

lib/Database/PostgreSQL/Opium/Oid.hs

@@ -5,6 +5,11 @@ import Database.PostgreSQL.LibPQ (Oid (..))
 eq :: Eq a => a -> a -> Bool
 eq = (==)
 
+-- raw byte string
+
+bytea :: Oid -> Bool
+bytea = eq $ Oid 17
+
 -- string types
 
 text :: Oid -> Bool

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -30,6 +30,12 @@ newtype AWord = AWord
 
 instance FromRow AWord where
 
+newtype AByteString = AByteString
+  { bytestring :: ByteString
+  } deriving (Eq, Generic, Show)
+
+instance FromRow AByteString where
+
 newtype AText = AText
   { text :: Text
   } deriving (Eq, Generic, Show)
@@ -106,6 +112,10 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)]
 
+  describe "FromField ByteString" $ do
+    it "Decodes bytea" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]
+
   describe "FromField Text" $ do
     it "Decodes text" $ \conn -> do
       shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"]
@@ -159,9 +169,6 @@ spec = 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

test/Database/PostgreSQL/OpiumSpec.hs

@@ -58,7 +58,7 @@ shouldHaveColumns
   -> [LibPQ.Column]
   -> IO ()
 shouldHaveColumns proxy conn query expectedColumns = do
-  Just result <- LibPQ.execParams conn query [] LibPQ.Text
+  Just result <- LibPQ.execParams conn query [] LibPQ.Binary
   columnTable <- Opium.getColumnTable proxy result
   let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable
   actualColumns `shouldBe` Right expectedColumns
@@ -81,13 +81,13 @@ spec = do
         [5, 3]
 
     it "Fails for missing columns" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Text
+      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
       columnTable <- Opium.getColumnTable @Person Proxy result
       columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
 
   describe "fromRow" $ do
     it "Decodes rows in a Result" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text
+      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
       Right columnTable <- Opium.getColumnTable @Person Proxy result
 
       row0 <- Opium.fromRow @Person result columnTable 0
@@ -97,21 +97,21 @@ spec = do
       row1 `shouldBe` Right (Person "albus" 103)
 
     it "Decodes NULL into Nothing for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Text
+      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
       Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
 
       row <- Opium.fromRow result columnTable 0
       row `shouldBe` Right (MaybeTest Nothing)
 
     it "Decodes values into Just for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Text
+      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
       Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
 
       row <- Opium.fromRow result columnTable 0
       row `shouldBe` Right (MaybeTest $ Just "abc")
 
     it "Works for many fields" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Text
+      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
       Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
 
       row <- Opium.fromRow result columnTable 0