{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
module Preql.Wire.FromSql where
import Preql.Wire.Errors
import Preql.Wire.Internal
import Preql.Wire.Tuples (deriveFromSqlTuple)
import Preql.Wire.Types
import Control.Monad.Except
import Control.Monad.Trans.State
import Data.Int
import Data.Time (Day, TimeOfDay, UTCTime)
import Data.UUID (UUID)
import Preql.Imports
import qualified BinaryParser as BP
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified PostgreSQL.Binary.Decoding as PGB
import qualified Preql.Wire.TypeInfo.Static as OID
data FieldDecoder a = FieldDecoder PgType (BP.BinaryParser a)
deriving a -> FieldDecoder b -> FieldDecoder a
(a -> b) -> FieldDecoder a -> FieldDecoder b
(forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b)
-> (forall a b. a -> FieldDecoder b -> FieldDecoder a)
-> Functor FieldDecoder
forall a b. a -> FieldDecoder b -> FieldDecoder a
forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FieldDecoder b -> FieldDecoder a
$c<$ :: forall a b. a -> FieldDecoder b -> FieldDecoder a
fmap :: (a -> b) -> FieldDecoder a -> FieldDecoder b
$cfmap :: forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b
Functor
throwLocated :: UnlocatedFieldError -> InternalDecoder a
throwLocated :: UnlocatedFieldError -> InternalDecoder a
throwLocated UnlocatedFieldError
failure = do
DecoderState{$sel:row:DecoderState :: DecoderState -> Row
row = PQ.Row CInt
r, $sel:column:DecoderState :: DecoderState -> Column
column = PQ.Col CInt
c} <- StateT DecoderState (ExceptT FieldError IO) DecoderState
forall (m :: * -> *) s. Monad m => StateT s m s
get
FieldError -> InternalDecoder a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> Int -> UnlocatedFieldError -> FieldError
FieldError (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c) UnlocatedFieldError
failure)
decodeVector :: (PgType -> IO (Either QueryError PQ.Oid)) -> RowDecoder a -> PQ.Result -> IO (Either QueryError (Vector a))
decodeVector :: (PgType -> IO (Either QueryError Oid))
-> RowDecoder a -> Result -> IO (Either QueryError (Vector a))
decodeVector PgType -> IO (Either QueryError Oid)
lookupType rd :: RowDecoder a
rd@(RowDecoder [PgType]
pgtypes InternalDecoder a
_parsers) Result
result = do
[TypeMismatch]
mismatches <- ([Maybe TypeMismatch] -> [TypeMismatch])
-> IO [Maybe TypeMismatch] -> IO [TypeMismatch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe TypeMismatch] -> [TypeMismatch]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe TypeMismatch] -> IO [TypeMismatch])
-> IO [Maybe TypeMismatch] -> IO [TypeMismatch]
forall a b. (a -> b) -> a -> b
$ [(Column, PgType)]
-> ((Column, PgType) -> IO (Maybe TypeMismatch))
-> IO [Maybe TypeMismatch]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Column] -> [PgType] -> [(Column, PgType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Column
0 ..] [PgType]
pgtypes) (((Column, PgType) -> IO (Maybe TypeMismatch))
-> IO [Maybe TypeMismatch])
-> ((Column, PgType) -> IO (Maybe TypeMismatch))
-> IO [Maybe TypeMismatch]
forall a b. (a -> b) -> a -> b
$ \(column :: Column
column@(PQ.Col CInt
cint), PgType
expected) -> do
Oid
actual <- Result -> Column -> IO Oid
PQ.ftype Result
result Column
column
Either QueryError Oid
e_expectedOid <- PgType -> IO (Either QueryError Oid)
lookupType PgType
expected
case Either QueryError Oid
e_expectedOid of
Right Oid
oid | Oid
actual Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
oid -> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeMismatch
forall a. Maybe a
Nothing
Either QueryError Oid
_ -> do
Maybe ByteString
m_name <- IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Result -> Column -> IO (Maybe ByteString)
PQ.fname Result
result Column
column
let columnName :: Maybe Text
columnName = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
m_name
Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TypeMismatch -> IO (Maybe TypeMismatch))
-> Maybe TypeMismatch -> IO (Maybe TypeMismatch)
forall a b. (a -> b) -> a -> b
$ TypeMismatch -> Maybe TypeMismatch
forall a. a -> Maybe a
Just (TypeMismatch :: PgType -> Oid -> Int -> Maybe Text -> TypeMismatch
TypeMismatch{column :: Int
column = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint, Maybe Text
Oid
PgType
columnName :: Maybe Text
actual :: Oid
expected :: PgType
columnName :: Maybe Text
actual :: Oid
expected :: PgType
..})
if Bool -> Bool
not ([TypeMismatch] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeMismatch]
mismatches)
then Either QueryError (Vector a) -> IO (Either QueryError (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryError -> Either QueryError (Vector a)
forall a b. a -> Either a b
Left ([TypeMismatch] -> QueryError
PgTypeMismatch [TypeMismatch]
mismatches))
else do
(PQ.Row CInt
ntuples) <- IO Row -> IO Row
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Row -> IO Row) -> IO Row -> IO Row
forall a b. (a -> b) -> a -> b
$ Result -> IO Row
PQ.ntuples Result
result
let toRow :: Int -> Row
toRow = Integer -> Row
forall a. Integral a => a -> Row
PQ.toRow (Integer -> Row) -> (Int -> Integer) -> Int -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Either FieldError (Vector a) -> Either QueryError (Vector a))
-> IO (Either FieldError (Vector a))
-> IO (Either QueryError (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldError -> QueryError)
-> Either FieldError (Vector a) -> Either QueryError (Vector a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FieldError -> QueryError
DecoderError) (IO (Either FieldError (Vector a))
-> IO (Either QueryError (Vector a)))
-> (ExceptT FieldError IO (Vector a)
-> IO (Either FieldError (Vector a)))
-> ExceptT FieldError IO (Vector a)
-> IO (Either QueryError (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT FieldError IO (Vector a)
-> IO (Either FieldError (Vector a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FieldError IO (Vector a)
-> IO (Either QueryError (Vector a)))
-> ExceptT FieldError IO (Vector a)
-> IO (Either QueryError (Vector a))
forall a b. (a -> b) -> a -> b
$
Int
-> (Int -> ExceptT FieldError IO a)
-> ExceptT FieldError IO (Vector a)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ntuples) (RowDecoder a -> Result -> Row -> ExceptT FieldError IO a
forall a. RowDecoder a -> Result -> Row -> ExceptT FieldError IO a
decodeRow RowDecoder a
rd Result
result (Row -> ExceptT FieldError IO a)
-> (Int -> Row) -> Int -> ExceptT FieldError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Row
toRow)
notNull :: FieldDecoder a -> RowDecoder a
notNull :: FieldDecoder a -> RowDecoder a
notNull (FieldDecoder PgType
oid BinaryParser a
parser) = [PgType] -> InternalDecoder a -> RowDecoder a
forall a. [PgType] -> InternalDecoder a -> RowDecoder a
RowDecoder [PgType
oid] (InternalDecoder a -> RowDecoder a)
-> InternalDecoder a -> RowDecoder a
forall a b. (a -> b) -> a -> b
$ do
Maybe ByteString
m_bs <- InternalDecoder (Maybe ByteString)
getNextValue
case Maybe ByteString
m_bs of
Maybe ByteString
Nothing -> UnlocatedFieldError -> InternalDecoder a
forall a. UnlocatedFieldError -> InternalDecoder a
throwLocated UnlocatedFieldError
UnexpectedNull
Just ByteString
bs -> (Text -> InternalDecoder a)
-> (a -> InternalDecoder a) -> Either Text a -> InternalDecoder a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UnlocatedFieldError -> InternalDecoder a
forall a. UnlocatedFieldError -> InternalDecoder a
throwLocated (UnlocatedFieldError -> InternalDecoder a)
-> (Text -> UnlocatedFieldError) -> Text -> InternalDecoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UnlocatedFieldError
ParseFailure) a -> InternalDecoder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinaryParser a -> ByteString -> Either Text a
forall a. BinaryParser a -> ByteString -> Either Text a
BP.run BinaryParser a
parser ByteString
bs)
nullable :: FieldDecoder a -> RowDecoder (Maybe a)
nullable :: FieldDecoder a -> RowDecoder (Maybe a)
nullable (FieldDecoder PgType
oid BinaryParser a
parser) = [PgType] -> InternalDecoder (Maybe a) -> RowDecoder (Maybe a)
forall a. [PgType] -> InternalDecoder a -> RowDecoder a
RowDecoder [PgType
oid] (InternalDecoder (Maybe a) -> RowDecoder (Maybe a))
-> InternalDecoder (Maybe a) -> RowDecoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
Maybe ByteString
m_bs <- InternalDecoder (Maybe ByteString)
getNextValue
case Maybe ByteString
m_bs of
Maybe ByteString
Nothing -> Maybe a -> InternalDecoder (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just ByteString
bs -> (Text -> InternalDecoder (Maybe a))
-> (a -> InternalDecoder (Maybe a))
-> Either Text a
-> InternalDecoder (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UnlocatedFieldError -> InternalDecoder (Maybe a)
forall a. UnlocatedFieldError -> InternalDecoder a
throwLocated (UnlocatedFieldError -> InternalDecoder (Maybe a))
-> (Text -> UnlocatedFieldError)
-> Text
-> InternalDecoder (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UnlocatedFieldError
ParseFailure) (Maybe a -> InternalDecoder (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> InternalDecoder (Maybe a))
-> (a -> Maybe a) -> a -> InternalDecoder (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (BinaryParser a -> ByteString -> Either Text a
forall a. BinaryParser a -> ByteString -> Either Text a
BP.run BinaryParser a
parser ByteString
bs)
class FromSqlField a where
fromSqlField :: FieldDecoder a
class FromSql a where
fromSql :: RowDecoder a
instance FromSqlField Bool where
fromSqlField :: FieldDecoder Bool
fromSqlField = PgType -> BinaryParser Bool -> FieldDecoder Bool
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.boolOid) BinaryParser Bool
PGB.bool
instance FromSql Bool where fromSql :: RowDecoder Bool
fromSql = FieldDecoder Bool -> RowDecoder Bool
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Bool
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Int16 where
fromSqlField :: FieldDecoder Int16
fromSqlField = PgType -> BinaryParser Int16 -> FieldDecoder Int16
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.int2Oid) BinaryParser Int16
forall a. (Integral a, Bits a) => Value a
PGB.int
instance FromSql Int16 where fromSql :: RowDecoder Int16
fromSql = FieldDecoder Int16 -> RowDecoder Int16
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Int16
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Int32 where
fromSqlField :: FieldDecoder Int32
fromSqlField = PgType -> BinaryParser Int32 -> FieldDecoder Int32
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.int4Oid) BinaryParser Int32
forall a. (Integral a, Bits a) => Value a
PGB.int
instance FromSql Int32 where fromSql :: RowDecoder Int32
fromSql = FieldDecoder Int32 -> RowDecoder Int32
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Int32
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Int64 where
fromSqlField :: FieldDecoder Int64
fromSqlField = PgType -> BinaryParser Int64 -> FieldDecoder Int64
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.int8Oid) BinaryParser Int64
forall a. (Integral a, Bits a) => Value a
PGB.int
instance FromSql Int64 where fromSql :: RowDecoder Int64
fromSql = FieldDecoder Int64 -> RowDecoder Int64
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Int64
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Float where
fromSqlField :: FieldDecoder Float
fromSqlField = PgType -> BinaryParser Float -> FieldDecoder Float
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.float4Oid) BinaryParser Float
PGB.float4
instance FromSql Float where fromSql :: RowDecoder Float
fromSql = FieldDecoder Float -> RowDecoder Float
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Float
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Double where
fromSqlField :: FieldDecoder Double
fromSqlField = PgType -> BinaryParser Double -> FieldDecoder Double
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.float8Oid) BinaryParser Double
PGB.float8
instance FromSql Double where fromSql :: RowDecoder Double
fromSql = FieldDecoder Double -> RowDecoder Double
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Double
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField String where
fromSqlField :: FieldDecoder String
fromSqlField = PgType -> BinaryParser String -> FieldDecoder String
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.textOid) (Text -> String
T.unpack (Text -> String) -> BinaryParser Text -> BinaryParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryParser Text
PGB.text_strict)
instance FromSql String where fromSql :: RowDecoder String
fromSql = FieldDecoder String -> RowDecoder String
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder String
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Text where
fromSqlField :: FieldDecoder Text
fromSqlField = PgType -> BinaryParser Text -> FieldDecoder Text
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.textOid) BinaryParser Text
PGB.text_strict
instance FromSql Text where fromSql :: RowDecoder Text
fromSql = FieldDecoder Text -> RowDecoder Text
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Text
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField TL.Text where
fromSqlField :: FieldDecoder Text
fromSqlField = PgType -> BinaryParser Text -> FieldDecoder Text
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.textOid) BinaryParser Text
PGB.text_lazy
instance FromSql TL.Text where fromSql :: RowDecoder Text
fromSql = FieldDecoder Text -> RowDecoder Text
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Text
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField ByteString where
fromSqlField :: FieldDecoder ByteString
fromSqlField = PgType -> BinaryParser ByteString -> FieldDecoder ByteString
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.byteaOid) (ByteString -> ByteString
BS.copy (ByteString -> ByteString)
-> BinaryParser ByteString -> BinaryParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryParser ByteString
BP.remainders)
instance FromSql ByteString where fromSql :: RowDecoder ByteString
fromSql = FieldDecoder ByteString -> RowDecoder ByteString
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder ByteString
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField BSL.ByteString where
fromSqlField :: FieldDecoder ByteString
fromSqlField = PgType -> BinaryParser ByteString -> FieldDecoder ByteString
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.byteaOid) (ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy (ByteString -> ByteString)
-> BinaryParser ByteString -> BinaryParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryParser ByteString
BP.remainders)
instance FromSql BSL.ByteString where fromSql :: RowDecoder ByteString
fromSql = FieldDecoder ByteString -> RowDecoder ByteString
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder ByteString
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField UTCTime where
fromSqlField :: FieldDecoder UTCTime
fromSqlField = PgType -> BinaryParser UTCTime -> FieldDecoder UTCTime
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.timestamptzOid) BinaryParser UTCTime
PGB.timestamptz_int
instance FromSql UTCTime where fromSql :: RowDecoder UTCTime
fromSql = FieldDecoder UTCTime -> RowDecoder UTCTime
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder UTCTime
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField Day where
fromSqlField :: FieldDecoder Day
fromSqlField = PgType -> BinaryParser Day -> FieldDecoder Day
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.dateOid) BinaryParser Day
PGB.date
instance FromSql Day where fromSql :: RowDecoder Day
fromSql = FieldDecoder Day -> RowDecoder Day
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Day
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField TimeOfDay where
fromSqlField :: FieldDecoder TimeOfDay
fromSqlField = PgType -> BinaryParser TimeOfDay -> FieldDecoder TimeOfDay
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.timeOid) BinaryParser TimeOfDay
PGB.time_int
instance FromSql TimeOfDay where fromSql :: RowDecoder TimeOfDay
fromSql = FieldDecoder TimeOfDay -> RowDecoder TimeOfDay
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder TimeOfDay
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField TimeTZ where
fromSqlField :: FieldDecoder TimeTZ
fromSqlField = PgType -> BinaryParser TimeTZ -> FieldDecoder TimeTZ
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.timetzOid) ((TimeOfDay -> TimeZone -> TimeTZ)
-> (TimeOfDay, TimeZone) -> TimeTZ
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeOfDay -> TimeZone -> TimeTZ
TimeTZ ((TimeOfDay, TimeZone) -> TimeTZ)
-> BinaryParser (TimeOfDay, TimeZone) -> BinaryParser TimeTZ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryParser (TimeOfDay, TimeZone)
PGB.timetz_int)
instance FromSql TimeTZ where fromSql :: RowDecoder TimeTZ
fromSql = FieldDecoder TimeTZ -> RowDecoder TimeTZ
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder TimeTZ
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField UUID where
fromSqlField :: FieldDecoder UUID
fromSqlField = PgType -> BinaryParser UUID -> FieldDecoder UUID
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.uuidOid) BinaryParser UUID
PGB.uuid
instance FromSql UUID where fromSql :: RowDecoder UUID
fromSql = FieldDecoder UUID -> RowDecoder UUID
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder UUID
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField PQ.Oid where
fromSqlField :: FieldDecoder Oid
fromSqlField = CUInt -> Oid
PQ.Oid (CUInt -> Oid) -> FieldDecoder CUInt -> FieldDecoder Oid
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PgType -> BinaryParser CUInt -> FieldDecoder CUInt
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.oidOid) BinaryParser CUInt
forall a. (Integral a, Bits a) => Value a
PGB.int
instance FromSql PQ.Oid where fromSql :: RowDecoder Oid
fromSql = FieldDecoder Oid -> RowDecoder Oid
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Oid
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance FromSqlField JSON.Value where
fromSqlField :: FieldDecoder Value
fromSqlField = PgType -> BinaryParser Value -> FieldDecoder Value
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.jsonbOid) BinaryParser Value
PGB.jsonb_ast
instance FromSql JSON.Value where fromSql :: RowDecoder Value
fromSql = FieldDecoder Value -> RowDecoder Value
forall a. FieldDecoder a -> RowDecoder a
notNull FieldDecoder Value
forall a. FromSqlField a => FieldDecoder a
fromSqlField
fromSqlJsonField :: JSON.FromJSON a => FieldDecoder a
fromSqlJsonField :: FieldDecoder a
fromSqlJsonField = PgType -> BinaryParser a -> FieldDecoder a
forall a. PgType -> BinaryParser a -> FieldDecoder a
FieldDecoder (Oid -> PgType
Oid Oid
OID.jsonbOid)
((ByteString -> Either Text a) -> BinaryParser a
forall a. (ByteString -> Either Text a) -> Value a
PGB.jsonb_bytes ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String a -> Either Text a)
-> (ByteString -> Either String a) -> ByteString -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode (ByteString -> Either String a)
-> (ByteString -> ByteString) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict))
instance {-# OVERLAPPABLE #-} FromSqlField a => FromSql (Maybe a) where
fromSql :: RowDecoder (Maybe a)
fromSql = FieldDecoder a -> RowDecoder (Maybe a)
forall a. FieldDecoder a -> RowDecoder (Maybe a)
nullable FieldDecoder a
forall a. FromSqlField a => FieldDecoder a
fromSqlField
instance (FromSql a, FromSql b) => FromSql (a, b) where
fromSql :: RowDecoder (a, b)
fromSql = (,) (a -> b -> (a, b)) -> RowDecoder a -> RowDecoder (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowDecoder a
forall a. FromSql a => RowDecoder a
fromSql RowDecoder (b -> (a, b)) -> RowDecoder b -> RowDecoder (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowDecoder b
forall a. FromSql a => RowDecoder a
fromSql
instance (FromSql a, FromSql b, FromSql c) => FromSql (a, b, c) where
fromSql :: RowDecoder (a, b, c)
fromSql = (,,) (a -> b -> c -> (a, b, c))
-> RowDecoder a -> RowDecoder (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowDecoder a
forall a. FromSql a => RowDecoder a
fromSql RowDecoder (b -> c -> (a, b, c))
-> RowDecoder b -> RowDecoder (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowDecoder b
forall a. FromSql a => RowDecoder a
fromSql RowDecoder (c -> (a, b, c)) -> RowDecoder c -> RowDecoder (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowDecoder c
forall a. FromSql a => RowDecoder a
fromSql
$(deriveFromSqlTuple 4)
$(deriveFromSqlTuple 5)
$(deriveFromSqlTuple 6)
$(deriveFromSqlTuple 7)
$(deriveFromSqlTuple 8)
$(deriveFromSqlTuple 9)
$(deriveFromSqlTuple 10)
$(deriveFromSqlTuple 11)
$(deriveFromSqlTuple 12)
$(deriveFromSqlTuple 13)
$(deriveFromSqlTuple 14)
$(deriveFromSqlTuple 15)
$(deriveFromSqlTuple 16)
$(deriveFromSqlTuple 17)
$(deriveFromSqlTuple 18)
$(deriveFromSqlTuple 19)
$(deriveFromSqlTuple 20)
$(deriveFromSqlTuple 21)
$(deriveFromSqlTuple 22)
$(deriveFromSqlTuple 23)
$(deriveFromSqlTuple 24)
$(deriveFromSqlTuple 25)