Decode values from binary instead of text format
This commit is contained in:
parent
83d2c07396
commit
4d21e67130
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user