Decode values from binary instead of text format
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user