{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
module Opaleye.Internal.Inferrable where
import qualified Opaleye.Field as F
import Opaleye.Internal.RunQuery (FromField, FromFields)
import qualified Opaleye.Internal.RunQuery as RQ
import qualified Opaleye.SqlTypes as T
import Opaleye.Internal.Constant (ToFields)
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D
import qualified Data.Scientific as Sci
import qualified Data.Text.Lazy as LT
import qualified Data.Text as ST
import qualified Data.Time.Compat as Time
import Data.Typeable (Typeable)
import Data.UUID (UUID)
import qualified Database.PostgreSQL.Simple.Range as R
import GHC.Int (Int32, Int64)
newtype Inferrable p a b = Inferrable { forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable :: p a b }
instance
D.Default (Inferrable FromField) a b
=> D.Default (Inferrable FromFields) (F.Field a) b where
def :: Inferrable FromFields (Field a) b
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall a b. FromField a b -> FromFields (Field a) b
RQ.fromFields (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))
instance
(D.Default (Inferrable FromField) a b, Maybe b ~ maybe_b)
=> D.Default (Inferrable FromFields) (F.FieldNullable a) maybe_b where
def :: Inferrable FromFields (FieldNullable a) maybe_b
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall a b. FromField a b -> FromFields (FieldNullable a) (Maybe b)
RQ.fromFieldsNullable (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))
instance int ~ Int => D.Default (Inferrable FromField) T.SqlInt4 int where
def :: Inferrable FromField SqlInt4 int
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance int64 ~ Int64 => D.Default (Inferrable FromField) T.SqlInt8 int64 where
def :: Inferrable FromField SqlInt8 int64
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance text ~ ST.Text => D.Default (Inferrable FromField) T.SqlText text where
def :: Inferrable FromField SqlText text
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance varchar ~ ST.Text => D.Default (Inferrable FromField) T.SqlVarcharN varchar where
def :: Inferrable FromField SqlVarcharN varchar
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance (Typeable h, D.Default (Inferrable FromField) f h, hs ~ [h])
=> D.Default (Inferrable FromField) (T.SqlArray f) hs where
def :: Inferrable FromField (SqlArray f) hs
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall h f.
Typeable h =>
FromField f h -> FromField (SqlArray_ 'NonNullable f) [h]
RQ.fromFieldArray (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))
instance (Typeable h, D.Default (Inferrable FromField) f h, hs ~ [Maybe h])
=> D.Default (Inferrable FromField) (T.SqlArray_ F.Nullable f) hs where
def :: Inferrable FromField (SqlArray_ 'Nullable f) hs
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall h f.
Typeable h =>
FromField f h -> FromField (SqlArray_ 'Nullable f) [Maybe h]
RQ.fromFieldArrayNullable (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))
instance double ~ Double => D.Default (Inferrable FromField) T.SqlFloat8 double where
def :: Inferrable FromField SqlFloat8 double
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance scientific ~ Sci.Scientific
=> D.Default (Inferrable FromField) T.SqlNumeric scientific where
def :: Inferrable FromField SqlNumeric scientific
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance bool ~ Bool => D.Default (Inferrable FromField) T.SqlBool bool where
def :: Inferrable FromField SqlBool bool
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance uuid ~ UUID => D.Default (Inferrable FromField) T.SqlUuid uuid where
def :: Inferrable FromField SqlUuid uuid
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance bytestring ~ SBS.ByteString
=> D.Default (Inferrable FromField) T.SqlBytea bytestring where
def :: Inferrable FromField SqlBytea bytestring
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance day ~ Time.Day
=> D.Default (Inferrable FromField) T.SqlDate day where
def :: Inferrable FromField SqlDate day
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance localtime ~ Time.LocalTime
=> D.Default (Inferrable FromField) T.SqlTimestamp localtime where
def :: Inferrable FromField SqlTimestamp localtime
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance timeofday ~ Time.TimeOfDay
=> D.Default (Inferrable FromField) T.SqlTime timeofday where
def :: Inferrable FromField SqlTime timeofday
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance calendardifftime ~ Time.CalendarDiffTime
=> D.Default (Inferrable FromField) T.SqlInterval calendardifftime where
def :: Inferrable FromField SqlInterval calendardifftime
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance cttext ~ CI.CI ST.Text
=> D.Default (Inferrable FromField) T.SqlCitext cttext where
def :: Inferrable FromField SqlCitext cttext
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field a ~ fieldA
=> D.Default (Inferrable ToFields) (F.Field a) fieldA where
def :: Inferrable ToFields (Field a) fieldA
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlText ~ cSqlText
=> D.Default (Inferrable ToFields) String cSqlText where
def :: Inferrable ToFields String cSqlText
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlBytea ~ cSqlBytea
=> D.Default (Inferrable ToFields) LBS.ByteString cSqlBytea where
def :: Inferrable ToFields ByteString cSqlBytea
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlBytea ~ cSqlBytea
=> D.Default (Inferrable ToFields) SBS.ByteString cSqlBytea where
def :: Inferrable ToFields ByteString cSqlBytea
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlText ~ cSqlText
=> D.Default (Inferrable ToFields) ST.Text cSqlText where
def :: Inferrable ToFields Text cSqlText
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlText ~ cSqlText
=> D.Default (Inferrable ToFields) LT.Text cSqlText where
def :: Inferrable ToFields Text cSqlText
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlNumeric ~ cSqlNumeric
=> D.Default (Inferrable ToFields) Sci.Scientific cSqlNumeric where
def :: Inferrable ToFields Scientific cSqlNumeric
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlInt4 ~ cSqlInt4
=> D.Default (Inferrable ToFields) Int cSqlInt4 where
def :: Inferrable ToFields Int cSqlInt4
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlInt4 ~ cSqlInt4
=> D.Default (Inferrable ToFields) Int32 cSqlInt4 where
def :: Inferrable ToFields Int32 cSqlInt4
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlInt8 ~ cSqlInt8
=> D.Default (Inferrable ToFields) Int64 cSqlInt8 where
def :: Inferrable ToFields Int64 cSqlInt8
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlFloat8 ~ cSqlFloat8
=> D.Default (Inferrable ToFields) Double cSqlFloat8 where
def :: Inferrable ToFields Double cSqlFloat8
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlBool ~ cSqlBool
=> D.Default (Inferrable ToFields) Bool cSqlBool where
def :: Inferrable ToFields Bool cSqlBool
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlUuid ~ cSqlUuid
=> D.Default (Inferrable ToFields) UUID cSqlUuid where
def :: Inferrable ToFields UUID cSqlUuid
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlDate ~ cSqlDate
=> D.Default (Inferrable ToFields) Time.Day cSqlDate where
def :: Inferrable ToFields Day cSqlDate
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz
=> D.Default (Inferrable ToFields) Time.UTCTime cSqlTimestamptz where
def :: Inferrable ToFields UTCTime cSqlTimestamptz
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlTimestamptz ~ cSqlTimestamptz
=> D.Default (Inferrable ToFields) Time.ZonedTime cSqlTimestamptz where
def :: Inferrable ToFields ZonedTime cSqlTimestamptz
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlTime ~ cSqlTime
=> D.Default (Inferrable ToFields) Time.TimeOfDay cSqlTime where
def :: Inferrable ToFields TimeOfDay cSqlTime
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlInterval ~ cSqlInterval
=> D.Default (Inferrable ToFields) Time.CalendarDiffTime cSqlInterval where
def :: Inferrable ToFields CalendarDiffTime cSqlInterval
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlCitext ~ cSqlCitext
=> D.Default (Inferrable ToFields) (CI.CI ST.Text) cSqlCitext where
def :: Inferrable ToFields (CI Text) cSqlCitext
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field T.SqlCitext ~ cSqlCitext
=> D.Default (Inferrable ToFields) (CI.CI LT.Text) cSqlCitext where
def :: Inferrable ToFields (CI Text) cSqlCitext
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlInt4) ~ cRangeInt4
=> D.Default (Inferrable ToFields) (R.PGRange Int) cRangeInt4 where
def :: Inferrable ToFields (PGRange Int) cRangeInt4
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlInt8) ~ cRangeInt8
=> D.Default (Inferrable ToFields) (R.PGRange Int64) cRangeInt8 where
def :: Inferrable ToFields (PGRange Int64) cRangeInt8
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlNumeric) ~ cRangeScientific
=> D.Default (Inferrable ToFields) (R.PGRange Sci.Scientific) cRangeScientific where
def :: Inferrable ToFields (PGRange Scientific) cRangeScientific
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlTimestamp) ~ cRangeTimestamp
=> D.Default (Inferrable ToFields) (R.PGRange Time.LocalTime) cRangeTimestamp where
def :: Inferrable ToFields (PGRange LocalTime) cRangeTimestamp
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlTimestamptz) ~ cRangeTimestamptz
=> D.Default (Inferrable ToFields) (R.PGRange Time.UTCTime) cRangeTimestamptz where
def :: Inferrable ToFields (PGRange UTCTime) cRangeTimestamptz
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance F.Field (T.SqlRange T.SqlDate) ~ cRangeDate
=> D.Default (Inferrable ToFields) (R.PGRange Time.Day) cRangeDate where
def :: Inferrable ToFields (PGRange Day) cRangeDate
def = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance Functor (p a) => Functor (Inferrable p a) where
fmap :: forall a b. (a -> b) -> Inferrable p a a -> Inferrable p a b
fmap a -> b
f = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable
instance Applicative (p a) => Applicative (Inferrable p a) where
pure :: forall a. a -> Inferrable p a a
pure = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Inferrable p a (a -> b)
f <*> :: forall a b.
Inferrable p a (a -> b) -> Inferrable p a a -> Inferrable p a b
<*> Inferrable p a a
x = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a a
x)
instance P.Profunctor p => P.Profunctor (Inferrable p) where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Inferrable p b c -> Inferrable p a d
dimap a -> b
f c -> d
g = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable
instance PP.ProductProfunctor p => PP.ProductProfunctor (Inferrable p) where
purePP :: forall b a. b -> Inferrable p a b
purePP = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b a. ProductProfunctor p => b -> p a b
PP.purePP
Inferrable p a (b -> c)
f **** :: forall a b c.
Inferrable p a (b -> c) -> Inferrable p a b -> Inferrable p a c
**** Inferrable p a b
g = forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a (b -> c)
f forall (p :: * -> * -> *) a b c.
ProductProfunctor p =>
p a (b -> c) -> p a b -> p a c
PP.**** forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a b
g)