Decode values from binary instead of text format

This commit is contained in:
Paul Brinkmeier 2023-09-23 05:53:30 +02:00
parent 83d2c07396
commit 4d21e67130
7 changed files with 76 additions and 57 deletions

View File

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

View File

@ -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)
getFieldText column =
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 ->
getValue :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
getValue oid = maybe (Right Nothing) $ \field ->
mapLeft
(ErrorInvalidField (ErrorPosition row nameText) oid fieldText)
(Just <$> fromField fieldText)
(ErrorInvalidField (ErrorPosition row nameText) oid field)
(Just <$> fromField field)
mapLeft :: (b -> c) -> Either b a -> Either c a
mapLeft f (Left l) = Left $ f l

View File

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

View File

@ -7,42 +7,42 @@ module Database.PostgreSQL.Opium.FromField
, fromField
) where
import Data.Attoparsec.Text
( Parser
, anyChar
, choice
, decimal
, double
, parseOnly
, signed
, string
, takeText
)
import Data.Attoparsec.ByteString (Parser)
import Data.Bits (Bits (..))
import Data.ByteString (ByteString)
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
doubleParser :: Parser Double
doubleParser = choice
[ string "NaN" $> nan
, signed (string "Infinity" $> infinity)
, double
]
where
nan = 0 / 0
infinity = 1 / 0
parseField = intParser
-- | 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
parseField = doubleParser
validOid Proxy = Oid.doublePrecision
parseField = unsafeCoerce <$> intParser @Word64
boolParser :: Parser Bool
boolParser = choice
[ string "t" $> True
, string "f" $> False
boolParser = AP.choice
[ AP.word8 1 $> True
, AP.word8 0 $> False
]
-- | See https://www.postgresql.org/docs/current/datatype-boolean.html.

View File

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

View File

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

View File

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