{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
module Opaleye.Internal.RunQuery where
import Control.Applicative
(Applicative, pure, (<$>), (*>), (<*>), liftA2)
import qualified Database.PostgreSQL.Simple as PGS
import qualified Database.PostgreSQL.Simple.Cursor as PGSC (Cursor)
import Database.PostgreSQL.Simple.Internal (RowParser)
import qualified Database.PostgreSQL.Simple.FromField as PGS
import Database.PostgreSQL.Simple.FromField
(FieldParser, fromField, pgArrayFieldParser, optionalField)
import Database.PostgreSQL.Simple.FromRow (fromRow, fieldWith)
import Database.PostgreSQL.Simple.Types (fromPGArray, Only(..))
import Opaleye.Internal.Column (Field_, Field, FieldNullable,
Nullability(Nullable, NonNullable))
import qualified Opaleye.Internal.PackMap as PackMap
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Column as C
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Internal.PGTypesExternal as T
import qualified Opaleye.Internal.PGTypes as IPT (strictDecodeUtf8)
import qualified Opaleye.Select as S
import qualified Opaleye.Sql as S
import qualified Data.Profunctor as P
import Data.Profunctor (dimap)
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D
import qualified Data.Aeson as Ae
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as ST
import qualified Data.Text.Encoding as STE
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LTE
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Time.Compat as Time
import qualified Data.Scientific as Sci
import qualified Data.String as String
import Data.UUID (UUID)
import GHC.Int (Int32, Int64)
import Database.PostgreSQL.Simple.FromField
(ResultError(UnexpectedNull, Incompatible), typeInfo, returnError)
import qualified Database.PostgreSQL.Simple.TypeInfo as TI
import qualified Database.PostgreSQL.Simple.Range as PGSR
import Data.Typeable (Typeable)
newtype FromField sqlType haskellType = FromField (FieldParser haskellType)
instance Functor (FromField u) where
fmap :: (a -> b) -> FromField u a -> FromField u b
fmap a -> b
f (FromField FieldParser a
fp) = FieldParser b -> FromField u b
forall sqlType haskellType.
FieldParser haskellType -> FromField sqlType haskellType
FromField ((((Maybe ByteString -> Conversion a)
-> Maybe ByteString -> Conversion b)
-> FieldParser a -> FieldParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe ByteString -> Conversion a)
-> Maybe ByteString -> Conversion b)
-> FieldParser a -> FieldParser b)
-> ((a -> b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b)
-> (a -> b)
-> FieldParser a
-> FieldParser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conversion a -> Conversion b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Conversion a -> Conversion b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b)
-> ((a -> b) -> Conversion a -> Conversion b)
-> (a -> b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Conversion a -> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f FieldParser a
fp)
data FromFields fields haskells =
FromFields (U.Unpackspec fields ())
(fields -> RowParser haskells)
(fields -> Int)
{-# DEPRECATED fieldQueryRunnerColumn "Will be removed in version 0.10. Use fromPGSFromField instead." #-}
fieldQueryRunnerColumn :: PGS.FromField haskell => FromField pgType haskell
fieldQueryRunnerColumn :: FromField pgType haskell
fieldQueryRunnerColumn = FromField pgType haskell
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
fromPGSFromField :: PGS.FromField haskell => FromField pgType haskell
fromPGSFromField :: FromField pgType haskell
fromPGSFromField = FieldParser haskell -> FromField pgType haskell
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser haskell
forall a. FromField a => FieldParser a
fromField
{-# DEPRECATED fieldParserQueryRunnerColumn " Will be removed in version 0.10. Use fromPGSFieldParser instead." #-}
fieldParserQueryRunnerColumn :: FieldParser haskell -> FromField pgType haskell
fieldParserQueryRunnerColumn :: FieldParser haskell -> FromField pgType haskell
fieldParserQueryRunnerColumn = FieldParser haskell -> FromField pgType haskell
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser
fromPGSFieldParser :: FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser :: FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser = FieldParser haskell -> FromField pgType haskell
forall sqlType haskellType.
FieldParser haskellType -> FromField sqlType haskellType
FromField
fromFields :: FromField a b -> FromFields (Field a) b
fromFields :: FromField a b -> FromFields (Field a) b
fromFields (FromField FieldParser b
fp) = FieldParser b -> FromFields (Field a) b
forall haskells (n :: Nullability) a.
FieldParser haskells -> FromFields (Field_ n a) haskells
fieldParserFromFields FieldParser b
fp
fieldParserFromFields :: FieldParser haskells -> FromFields (Field_ n a) haskells
fieldParserFromFields :: FieldParser haskells -> FromFields (Field_ n a) haskells
fieldParserFromFields FieldParser haskells
fp = Unpackspec (Field_ n a) ()
-> (Field_ n a -> RowParser haskells)
-> (Field_ n a -> Int)
-> FromFields (Field_ n a) haskells
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields ((Field_ n a -> ())
-> Unpackspec (Field_ n a) (Field_ n a)
-> Unpackspec (Field_ n a) ()
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
P.rmap (() -> Field_ n a -> ()
forall a b. a -> b -> a
const ()) Unpackspec (Field_ n a) (Field_ n a)
forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
U.unpackspecField) (RowParser haskells -> Field_ n a -> RowParser haskells
forall a b. a -> b -> a
const (FieldParser haskells -> RowParser haskells
forall a. FieldParser a -> RowParser a
fieldWith FieldParser haskells
fp)) (Int -> Field_ n a -> Int
forall a b. a -> b -> a
const Int
1)
{-# DEPRECATED queryRunner "Use fromFields instead. Will be removed in version 0.10." #-}
queryRunner :: FromField a b -> FromFields (Field a) b
queryRunner :: FromField a b -> FromFields (Field a) b
queryRunner = FromField a b -> FromFields (Field a) b
forall a b. FromField a b -> FromFields (Field a) b
fromFields
fromFieldsNullable :: FromField a b -> FromFields (FieldNullable a) (Maybe b)
fromFieldsNullable :: FromField a b -> FromFields (FieldNullable a) (Maybe b)
fromFieldsNullable (FromField FieldParser b
fp) = FieldParser (Maybe b) -> FromFields (FieldNullable a) (Maybe b)
forall haskells (n :: Nullability) a.
FieldParser haskells -> FromFields (Field_ n a) haskells
fieldParserFromFields (FieldParser b -> FieldParser (Maybe b)
forall a. FieldParser a -> FieldParser (Maybe a)
optionalField FieldParser b
fp)
unsafeFromFieldRaw :: FromField a (PGS.Field, Maybe SBS.ByteString)
unsafeFromFieldRaw :: FromField a (Field, Maybe ByteString)
unsafeFromFieldRaw = FieldParser (Field, Maybe ByteString)
-> FromField a (Field, Maybe ByteString)
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser (\Field
f Maybe ByteString
mdata -> (Field, Maybe ByteString) -> Conversion (Field, Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field
f, Maybe ByteString
mdata))
instance DefaultFromField a b =>
D.Default FromFields (Field a) b where
def :: FromFields (Field a) b
def = FromField a b -> FromFields (Field a) b
forall a b. FromField a b -> FromFields (Field a) b
fromFields FromField a b
forall sqlType haskellType.
DefaultFromField sqlType haskellType =>
FromField sqlType haskellType
defaultFromField
instance DefaultFromField a b =>
D.Default FromFields (FieldNullable a) (Maybe b)
where def :: FromFields (FieldNullable a) (Maybe b)
def = FromField a b -> FromFields (FieldNullable a) (Maybe b)
forall a b. FromField a b -> FromFields (FieldNullable a) (Maybe b)
fromFieldsNullable FromField a b
forall sqlType haskellType.
DefaultFromField sqlType haskellType =>
FromField sqlType haskellType
defaultFromField
class DefaultFromField sqlType haskellType where
defaultFromField :: FromField sqlType haskellType
instance DefaultFromField sqlType haskellType
=> D.Default FromField sqlType haskellType where
def :: FromField sqlType haskellType
def = FromField sqlType haskellType
forall sqlType haskellType.
DefaultFromField sqlType haskellType =>
FromField sqlType haskellType
defaultFromField
instance DefaultFromField T.SqlNumeric Sci.Scientific where
defaultFromField :: FromField SqlNumeric Scientific
defaultFromField = FromField SqlNumeric Scientific
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlInt4 Int where
defaultFromField :: FromField SqlInt4 Int
defaultFromField = FromField SqlInt4 Int
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlInt4 Int32 where
defaultFromField :: FromField SqlInt4 Int32
defaultFromField = FromField SqlInt4 Int32
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlInt8 Int64 where
defaultFromField :: FromField SqlInt8 Int64
defaultFromField = FromField SqlInt8 Int64
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlText String where
defaultFromField :: FromField SqlText String
defaultFromField = FromField SqlText String
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlFloat8 Double where
defaultFromField :: FromField SqlFloat8 Double
defaultFromField = FromField SqlFloat8 Double
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlBool Bool where
defaultFromField :: FromField SqlBool Bool
defaultFromField = FromField SqlBool Bool
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlUuid UUID where
defaultFromField :: FromField SqlUuid UUID
defaultFromField = FromField SqlUuid UUID
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlBytea SBS.ByteString where
defaultFromField :: FromField SqlBytea ByteString
defaultFromField = FromField SqlBytea ByteString
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlBytea LBS.ByteString where
defaultFromField :: FromField SqlBytea ByteString
defaultFromField = FromField SqlBytea ByteString
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlText ST.Text where
defaultFromField :: FromField SqlText Text
defaultFromField = FromField SqlText Text
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlText LT.Text where
defaultFromField :: FromField SqlText Text
defaultFromField = FromField SqlText Text
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlVarcharN String where
defaultFromField :: FromField SqlVarcharN String
defaultFromField = FromField SqlVarcharN String
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlVarcharN ST.Text where
defaultFromField :: FromField SqlVarcharN Text
defaultFromField = FromField SqlVarcharN Text
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlVarcharN LT.Text where
defaultFromField :: FromField SqlVarcharN Text
defaultFromField = FromField SqlVarcharN Text
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlDate Time.Day where
defaultFromField :: FromField SqlDate Day
defaultFromField = FromField SqlDate Day
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlTimestamptz Time.UTCTime where
defaultFromField :: FromField SqlTimestamptz UTCTime
defaultFromField = FromField SqlTimestamptz UTCTime
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlTimestamp Time.LocalTime where
defaultFromField :: FromField SqlTimestamp LocalTime
defaultFromField = FromField SqlTimestamp LocalTime
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlTimestamptz Time.ZonedTime where
defaultFromField :: FromField SqlTimestamptz ZonedTime
defaultFromField = FromField SqlTimestamptz ZonedTime
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlInterval Time.CalendarDiffTime where
defaultFromField :: FromField SqlInterval CalendarDiffTime
defaultFromField = FromField SqlInterval CalendarDiffTime
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlTime Time.TimeOfDay where
defaultFromField :: FromField SqlTime TimeOfDay
defaultFromField = FromField SqlTime TimeOfDay
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlCitext (CI.CI ST.Text) where
defaultFromField :: FromField SqlCitext (CI Text)
defaultFromField = FromField SqlCitext (CI Text)
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlCitext (CI.CI LT.Text) where
defaultFromField :: FromField SqlCitext (CI Text)
defaultFromField = FromField SqlCitext (CI Text)
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlJson String where
defaultFromField :: FromField SqlJson String
defaultFromField = FieldParser String -> FromField SqlJson String
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser String
jsonFieldParser
instance DefaultFromField T.SqlJson ST.Text where
defaultFromField :: FromField SqlJson Text
defaultFromField = FieldParser Text -> FromField SqlJson Text
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser Text
jsonFieldTextParser
instance DefaultFromField T.SqlJson LT.Text where
defaultFromField :: FromField SqlJson Text
defaultFromField = FieldParser Text -> FromField SqlJson Text
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser Text
jsonFieldLazyTextParser
instance DefaultFromField T.SqlJson SBS.ByteString where
defaultFromField :: FromField SqlJson ByteString
defaultFromField = FieldParser ByteString -> FromField SqlJson ByteString
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser ByteString
jsonFieldByteParser
instance DefaultFromField T.SqlJson LBS.ByteString where
defaultFromField :: FromField SqlJson ByteString
defaultFromField = FieldParser ByteString -> FromField SqlJson ByteString
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser ByteString
jsonFieldLazyByteParser
instance DefaultFromField T.SqlJson Ae.Value where
defaultFromField :: FromField SqlJson Value
defaultFromField = FromField SqlJson Value
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance DefaultFromField T.SqlJsonb String where
defaultFromField :: FromField SqlJsonb String
defaultFromField = FieldParser String -> FromField SqlJsonb String
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser String
jsonbFieldParser
instance DefaultFromField T.SqlJsonb ST.Text where
defaultFromField :: FromField SqlJsonb Text
defaultFromField = FieldParser Text -> FromField SqlJsonb Text
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser Text
jsonbFieldTextParser
instance DefaultFromField T.SqlJsonb LT.Text where
defaultFromField :: FromField SqlJsonb Text
defaultFromField = FieldParser Text -> FromField SqlJsonb Text
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser Text
jsonbFieldLazyTextParser
instance DefaultFromField T.SqlJsonb SBS.ByteString where
defaultFromField :: FromField SqlJsonb ByteString
defaultFromField = FieldParser ByteString -> FromField SqlJsonb ByteString
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser ByteString
jsonbFieldByteParser
instance DefaultFromField T.SqlJsonb LBS.ByteString where
defaultFromField :: FromField SqlJsonb ByteString
defaultFromField = FieldParser ByteString -> FromField SqlJsonb ByteString
forall haskell pgType.
FieldParser haskell -> FromField pgType haskell
fromPGSFieldParser FieldParser ByteString
jsonbFieldLazyByteParser
instance DefaultFromField T.SqlJsonb Ae.Value where
defaultFromField :: FromField SqlJsonb Value
defaultFromField = FromField SqlJsonb Value
forall haskell pgType.
FromField haskell =>
FromField pgType haskell
fromPGSFromField
instance (Typeable b, DefaultFromField a b) =>
DefaultFromField (T.SqlArray_ NonNullable a) [b] where
defaultFromField :: FromField (SqlArray_ 'NonNullable a) [b]
defaultFromField = FromField a b -> FromField (SqlArray_ 'NonNullable a) [b]
forall h f.
Typeable h =>
FromField f h -> FromField (SqlArray_ 'NonNullable f) [h]
fromFieldArray FromField a b
forall sqlType haskellType.
DefaultFromField sqlType haskellType =>
FromField sqlType haskellType
defaultFromField
fromFieldArray :: Typeable h => FromField f h -> FromField (T.SqlArray_ NonNullable f) [h]
fromFieldArray :: FromField f h -> FromField (SqlArray_ 'NonNullable f) [h]
fromFieldArray (FromField FieldParser h
f) =
(PGArray h -> [h])
-> FromField (SqlArray_ 'NonNullable f) (PGArray h)
-> FromField (SqlArray_ 'NonNullable f) [h]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PGArray h -> [h]
forall a. PGArray a -> [a]
fromPGArray (FieldParser (PGArray h)
-> FromField (SqlArray_ 'NonNullable f) (PGArray h)
forall sqlType haskellType.
FieldParser haskellType -> FromField sqlType haskellType
FromField (FieldParser h -> FieldParser (PGArray h)
forall a. Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser FieldParser h
f))
fromFieldArrayNullable :: Typeable h => FromField f h -> FromField (T.SqlArray_ 'Nullable f) [Maybe h]
fromFieldArrayNullable :: FromField f h -> FromField (SqlArray_ 'Nullable f) [Maybe h]
fromFieldArrayNullable (FromField FieldParser h
f) =
(PGArray (Maybe h) -> [Maybe h])
-> FromField (SqlArray_ 'Nullable f) (PGArray (Maybe h))
-> FromField (SqlArray_ 'Nullable f) [Maybe h]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PGArray (Maybe h) -> [Maybe h]
forall a. PGArray a -> [a]
fromPGArray (FieldParser (PGArray (Maybe h))
-> FromField (SqlArray_ 'Nullable f) (PGArray (Maybe h))
forall sqlType haskellType.
FieldParser haskellType -> FromField sqlType haskellType
FromField (FieldParser (Maybe h) -> FieldParser (PGArray (Maybe h))
forall a. Typeable a => FieldParser a -> FieldParser (PGArray a)
pgArrayFieldParser (FieldParser h -> FieldParser (Maybe h)
forall a. FieldParser a -> FieldParser (Maybe a)
optionalField FieldParser h
f)))
instance (Typeable b, DefaultFromField a b) =>
DefaultFromField (T.SqlRange a) (PGSR.PGRange b) where
defaultFromField :: FromField (SqlRange a) (PGRange b)
defaultFromField = FromField a b -> FromField (SqlRange a) (PGRange b)
forall b a.
Typeable b =>
FromField a b -> FromField (SqlRange a) (PGRange b)
fromFieldRange FromField a b
forall sqlType haskellType.
DefaultFromField sqlType haskellType =>
FromField sqlType haskellType
defaultFromField
fromFieldRange :: Typeable b
=> FromField a b
-> FromField (T.SqlRange a) (PGSR.PGRange b)
fromFieldRange :: FromField a b -> FromField (SqlRange a) (PGRange b)
fromFieldRange (FromField FieldParser b
pff) = FieldParser (PGRange b) -> FromField (SqlRange a) (PGRange b)
forall sqlType haskellType.
FieldParser haskellType -> FromField sqlType haskellType
FromField (FieldParser b -> FieldParser (PGRange b)
forall a. Typeable a => FieldParser a -> FieldParser (PGRange a)
PGSR.fromFieldRange FieldParser b
pff)
instance Functor (FromFields c) where
fmap :: (a -> b) -> FromFields c a -> FromFields c b
fmap a -> b
f (FromFields Unpackspec c ()
u c -> RowParser a
r c -> Int
b) = Unpackspec c ()
-> (c -> RowParser b) -> (c -> Int) -> FromFields c b
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields Unpackspec c ()
u (((RowParser a -> RowParser b)
-> (c -> RowParser a) -> c -> RowParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RowParser a -> RowParser b)
-> (c -> RowParser a) -> c -> RowParser b)
-> ((a -> b) -> RowParser a -> RowParser b)
-> (a -> b)
-> (c -> RowParser a)
-> c
-> RowParser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f c -> RowParser a
r) c -> Int
b
instance Applicative (FromFields c) where
pure :: a -> FromFields c a
pure = ((c -> RowParser a) -> (c -> Int) -> FromFields c a)
-> (c -> Int) -> (c -> RowParser a) -> FromFields c a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Unpackspec c ()
-> (c -> RowParser a) -> (c -> Int) -> FromFields c a
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields (() -> Unpackspec c ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) (Int -> c -> Int
forall a b. a -> b -> a
const Int
0)
((c -> RowParser a) -> FromFields c a)
-> (a -> c -> RowParser a) -> a -> FromFields c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowParser a -> c -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(RowParser a -> c -> RowParser a)
-> (a -> RowParser a) -> a -> c -> RowParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
FromFields Unpackspec c ()
uf c -> RowParser (a -> b)
rf c -> Int
bf <*> :: FromFields c (a -> b) -> FromFields c a -> FromFields c b
<*> FromFields Unpackspec c ()
ux c -> RowParser a
rx c -> Int
bx =
Unpackspec c ()
-> (c -> RowParser b) -> (c -> Int) -> FromFields c b
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields (Unpackspec c ()
uf Unpackspec c () -> Unpackspec c () -> Unpackspec c ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Unpackspec c ()
ux) (RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (RowParser (a -> b) -> RowParser a -> RowParser b)
-> (c -> RowParser (a -> b)) -> c -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> RowParser (a -> b)
rf (c -> RowParser a -> RowParser b)
-> (c -> RowParser a) -> c -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> RowParser a
rx) ((Int -> Int -> Int) -> (c -> Int) -> (c -> Int) -> c -> Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) c -> Int
bf c -> Int
bx)
instance P.Profunctor FromFields where
dimap :: (a -> b) -> (c -> d) -> FromFields b c -> FromFields a d
dimap a -> b
f c -> d
g (FromFields Unpackspec b ()
u b -> RowParser c
r b -> Int
b) =
Unpackspec a ()
-> (a -> RowParser d) -> (a -> Int) -> FromFields a d
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields ((a -> b) -> Unpackspec b () -> Unpackspec a ()
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap a -> b
f Unpackspec b ()
u) ((a -> b)
-> (RowParser c -> RowParser d)
-> (b -> RowParser c)
-> a
-> RowParser d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
f ((c -> d) -> RowParser c -> RowParser d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) b -> RowParser c
r) ((a -> b) -> (b -> Int) -> a -> Int
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap a -> b
f b -> Int
b)
instance PP.ProductProfunctor FromFields where
purePP :: b -> FromFields a b
purePP = b -> FromFields a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
**** :: FromFields a (b -> c) -> FromFields a b -> FromFields a c
(****) = FromFields a (b -> c) -> FromFields a b -> FromFields a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance PP.SumProfunctor FromFields where
FromFields a b
f +++! :: FromFields a b
-> FromFields a' b' -> FromFields (Either a a') (Either b b')
+++! FromFields a' b'
g = Unpackspec (Either a a') ()
-> (Either a a' -> RowParser (Either b b'))
-> (Either a a' -> Int)
-> FromFields (Either a a') (Either b b')
forall fields haskells.
Unpackspec fields ()
-> (fields -> RowParser haskells)
-> (fields -> Int)
-> FromFields fields haskells
FromFields ((Either () () -> ())
-> Unpackspec (Either a a') (Either () ())
-> Unpackspec (Either a a') ()
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
P.rmap (() -> Either () () -> ()
forall a b. a -> b -> a
const ()) (Unpackspec a ()
fu Unpackspec a ()
-> Unpackspec a' () -> Unpackspec (Either a a') (Either () ())
forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
PP.+++! Unpackspec a' ()
gu))
((a -> RowParser b)
-> (a' -> RowParser b') -> Either a a' -> RowParser (Either b b')
forall (p :: * -> * -> *) (f :: * -> *) a b a' b'.
(SumProfunctor p, Functor f) =>
p a (f b) -> p a' (f b') -> p (Either a a') (f (Either b b'))
PackMap.eitherFunction a -> RowParser b
fr a' -> RowParser b'
gr)
((a -> Int) -> (a' -> Int) -> Either a a' -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Int
fb a' -> Int
gb)
where FromFields Unpackspec a ()
fu a -> RowParser b
fr a -> Int
fb = FromFields a b
f
FromFields Unpackspec a' ()
gu a' -> RowParser b'
gr a' -> Int
gb = FromFields a' b'
g
jsonFieldParser, jsonbFieldParser :: FieldParser String
jsonFieldParser :: FieldParser String
jsonFieldParser = ByteString -> FieldParser String
jsonFieldTypeParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"json")
jsonbFieldParser :: FieldParser String
jsonbFieldParser = ByteString -> FieldParser String
jsonFieldTypeParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"jsonb")
jsonFieldTextParser, jsonbFieldTextParser :: FieldParser ST.Text
jsonFieldTextParser :: FieldParser Text
jsonFieldTextParser = ByteString -> FieldParser Text
jsonFieldTypeTextParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"json")
jsonbFieldTextParser :: FieldParser Text
jsonbFieldTextParser = ByteString -> FieldParser Text
jsonFieldTypeTextParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"jsonb")
jsonFieldLazyTextParser, jsonbFieldLazyTextParser :: FieldParser LT.Text
jsonFieldLazyTextParser :: FieldParser Text
jsonFieldLazyTextParser = ByteString -> FieldParser Text
jsonFieldTypeLazyTextParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"json")
jsonbFieldLazyTextParser :: FieldParser Text
jsonbFieldLazyTextParser = ByteString -> FieldParser Text
jsonFieldTypeLazyTextParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"jsonb")
jsonFieldByteParser, jsonbFieldByteParser :: FieldParser SBS.ByteString
jsonFieldByteParser :: FieldParser ByteString
jsonFieldByteParser = ByteString -> FieldParser ByteString
jsonFieldTypeByteParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"json")
jsonbFieldByteParser :: FieldParser ByteString
jsonbFieldByteParser = ByteString -> FieldParser ByteString
jsonFieldTypeByteParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"jsonb")
jsonFieldLazyByteParser, jsonbFieldLazyByteParser :: FieldParser LBS.ByteString
jsonFieldLazyByteParser :: FieldParser ByteString
jsonFieldLazyByteParser = ByteString -> FieldParser ByteString
jsonFieldTypeLazyByteParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"json")
jsonbFieldLazyByteParser :: FieldParser ByteString
jsonbFieldLazyByteParser = ByteString -> FieldParser ByteString
jsonFieldTypeLazyByteParser (String -> ByteString
forall a. IsString a => String -> a
String.fromString String
"jsonb")
jsonFieldTypeByteParser :: SBS.ByteString -> FieldParser SBS.ByteString
jsonFieldTypeByteParser :: ByteString -> FieldParser ByteString
jsonFieldTypeByteParser ByteString
jsonTypeName Field
field Maybe ByteString
mData = do
TypeInfo
ti <- Field -> Conversion TypeInfo
typeInfo Field
field
if TypeInfo -> ByteString
TI.typname TypeInfo
ti ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
jsonTypeName
then Conversion ByteString
convert
else (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ByteString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
field String
"types incompatible"
where
convert :: Conversion ByteString
convert = case Maybe ByteString
mData of
Just ByteString
bs -> ByteString -> Conversion ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
Maybe ByteString
_ -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ByteString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
field String
""
withJsonByteStringParser :: (SBS.ByteString -> b)
-> SBS.ByteString -> FieldParser b
withJsonByteStringParser :: (ByteString -> b) -> ByteString -> FieldParser b
withJsonByteStringParser ByteString -> b
f = ((FieldParser ByteString -> FieldParser b)
-> (ByteString -> FieldParser ByteString)
-> ByteString
-> FieldParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldParser ByteString -> FieldParser b)
-> (ByteString -> FieldParser ByteString)
-> ByteString
-> FieldParser b)
-> ((ByteString -> b) -> FieldParser ByteString -> FieldParser b)
-> (ByteString -> b)
-> (ByteString -> FieldParser ByteString)
-> ByteString
-> FieldParser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString -> Conversion b)
-> FieldParser ByteString -> FieldParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString -> Conversion b)
-> FieldParser ByteString -> FieldParser b)
-> ((ByteString -> b)
-> (Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString
-> Conversion b)
-> (ByteString -> b)
-> FieldParser ByteString
-> FieldParser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conversion ByteString -> Conversion b)
-> (Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString
-> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Conversion ByteString -> Conversion b)
-> (Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString
-> Conversion b)
-> ((ByteString -> b) -> Conversion ByteString -> Conversion b)
-> (ByteString -> b)
-> (Maybe ByteString -> Conversion ByteString)
-> Maybe ByteString
-> Conversion b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> b) -> Conversion ByteString -> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> b
f ByteString -> FieldParser ByteString
jsonFieldTypeByteParser
jsonFieldTypeParser :: SBS.ByteString -> FieldParser String
jsonFieldTypeParser :: ByteString -> FieldParser String
jsonFieldTypeParser = (ByteString -> String) -> ByteString -> FieldParser String
forall b. (ByteString -> b) -> ByteString -> FieldParser b
withJsonByteStringParser ByteString -> String
IPT.strictDecodeUtf8
jsonFieldTypeTextParser :: SBS.ByteString -> FieldParser ST.Text
jsonFieldTypeTextParser :: ByteString -> FieldParser Text
jsonFieldTypeTextParser = (ByteString -> Text) -> ByteString -> FieldParser Text
forall b. (ByteString -> b) -> ByteString -> FieldParser b
withJsonByteStringParser ByteString -> Text
STE.decodeUtf8
jsonFieldTypeLazyTextParser :: SBS.ByteString -> FieldParser LT.Text
jsonFieldTypeLazyTextParser :: ByteString -> FieldParser Text
jsonFieldTypeLazyTextParser = (ByteString -> Text) -> ByteString -> FieldParser Text
forall b. (ByteString -> b) -> ByteString -> FieldParser b
withJsonByteStringParser (ByteString -> Text
LTE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict)
jsonFieldTypeLazyByteParser :: SBS.ByteString -> FieldParser LBS.ByteString
jsonFieldTypeLazyByteParser :: ByteString -> FieldParser ByteString
jsonFieldTypeLazyByteParser = (ByteString -> ByteString) -> ByteString -> FieldParser ByteString
forall b. (ByteString -> b) -> ByteString -> FieldParser b
withJsonByteStringParser ByteString -> ByteString
LBS.fromStrict
prepareRowParser :: FromFields columns haskells -> columns -> RowParser haskells
prepareRowParser :: FromFields columns haskells -> columns -> RowParser haskells
prepareRowParser (FromFields Unpackspec columns ()
_ columns -> RowParser haskells
rowParser columns -> Int
numColumns) columns
cols =
if columns -> Int
numColumns columns
cols Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then columns -> RowParser haskells
rowParser columns
cols
else (RowParser (Only Int)
forall a. FromRow a => RowParser a
fromRow :: RowParser (Only Int)) RowParser (Only Int) -> RowParser haskells -> RowParser haskells
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> columns -> RowParser haskells
rowParser columns
cols
data Cursor haskells = EmptyCursor | Cursor (RowParser haskells) PGSC.Cursor
prepareQuery :: FromFields fields haskells -> S.Select fields -> (Maybe PGS.Query, RowParser haskells)
prepareQuery :: FromFields fields haskells
-> Select fields -> (Maybe Query, RowParser haskells)
prepareQuery qr :: FromFields fields haskells
qr@(FromFields Unpackspec fields ()
u fields -> RowParser haskells
_ fields -> Int
_) Select fields
q = (Maybe Query
sql, RowParser haskells
parser)
where sql :: Maybe PGS.Query
sql :: Maybe Query
sql = (String -> Query) -> Maybe String -> Maybe Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Query
forall a. IsString a => String -> a
String.fromString (Unpackspec fields () -> Select fields -> Maybe String
forall fields b.
Unpackspec fields b -> Select fields -> Maybe String
S.showSqlExplicit Unpackspec fields ()
u Select fields
q)
(fields
b, PrimQuery
_, Tag
_) = Select fields -> () -> (fields, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Q.runSimpleQueryArrStart Select fields
q ()
parser :: RowParser haskells
parser = FromFields fields haskells -> fields -> RowParser haskells
forall columns haskells.
FromFields columns haskells -> columns -> RowParser haskells
prepareRowParser FromFields fields haskells
qr fields
b