{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
module Opaleye.Internal.Constant where
import Opaleye.Field (Field)
import qualified Opaleye.Field as F
import qualified Opaleye.SqlTypes as T
import qualified Data.Aeson as Ae
import qualified Data.CaseInsensitive as CI
import qualified Data.Int as Int
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Scientific as Sci
import qualified Data.Time.Compat as Time
import qualified Data.UUID as UUID
import qualified Data.Profunctor.Product as PP
import Data.Profunctor.Product (empty, (***!), (+++!))
import qualified Data.Profunctor.Product.Default as D
import qualified Data.Profunctor as P
import Control.Applicative (Applicative, pure, (<*>))
import Data.Functor ((<$>))
import qualified Database.PostgreSQL.Simple.Range as R
import Database.PostgreSQL.Simple.Newtypes ( Aeson, getAeson )
toFields :: D.Default ToFields haskells fields
=> haskells -> fields
toFields :: forall haskells fields.
Default ToFields haskells fields =>
haskells -> fields
toFields = forall haskells fields.
ToFields haskells fields -> haskells -> fields
constantExplicit forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
newtype ToFields haskells fields =
ToFields { forall haskells fields.
ToFields haskells fields -> haskells -> fields
constantExplicit :: haskells -> fields }
instance D.Default ToFields haskell (F.Field sql)
=> D.Default ToFields (Maybe haskell) (F.FieldNullable sql) where
def :: ToFields (Maybe haskell) (FieldNullable sql)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (forall a. Maybe (Field a) -> FieldNullable a
F.maybeToNullable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap haskell -> Field sql
f)
where ToFields haskell -> Field sql
f = forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
toToFields :: (haskells -> fields) -> ToFields haskells fields
toToFields :: forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields
instance D.Default ToFields (Field a) (Field a) where
def :: ToFields (Field a) (Field a)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a. a -> a
id
instance D.Default ToFields String (Field T.SqlText) where
def :: ToFields String (Field SqlText)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields String -> Field SqlText
T.sqlString
instance D.Default ToFields LBS.ByteString (Field T.SqlBytea) where
def :: ToFields ByteString (Field SqlBytea)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlBytea
T.sqlLazyByteString
instance D.Default ToFields SBS.ByteString (Field T.SqlBytea) where
def :: ToFields ByteString (Field SqlBytea)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlBytea
T.sqlStrictByteString
instance D.Default ToFields ST.Text (Field T.SqlText) where
def :: ToFields Text (Field SqlText)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Text -> Field SqlText
T.sqlStrictText
instance D.Default ToFields LT.Text (Field T.SqlText) where
def :: ToFields Text (Field SqlText)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Text -> Field SqlText
T.sqlLazyText
instance D.Default ToFields String (Field T.SqlVarcharN) where
def :: ToFields String (Field SqlVarcharN)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields String -> Field SqlVarcharN
T.sqlStringVarcharN
instance D.Default ToFields ST.Text (Field T.SqlVarcharN) where
def :: ToFields Text (Field SqlVarcharN)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Text -> Field SqlVarcharN
T.sqlStrictTextVarcharN
instance D.Default ToFields LT.Text (Field T.SqlVarcharN) where
def :: ToFields Text (Field SqlVarcharN)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Text -> Field SqlVarcharN
T.sqlLazyTextVarcharN
instance D.Default ToFields Sci.Scientific (Field T.SqlNumeric) where
def :: ToFields Scientific (Field SqlNumeric)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Scientific -> Field SqlNumeric
T.sqlNumeric
instance D.Default ToFields Int (Field T.SqlInt4) where
def :: ToFields Int (Field SqlInt4)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Int -> Field SqlInt4
T.sqlInt4
instance D.Default ToFields Int.Int32 (Field T.SqlInt4) where
def :: ToFields Int32 (Field SqlInt4)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ Int -> Field SqlInt4
T.sqlInt4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance D.Default ToFields Int.Int64 (Field T.SqlInt8) where
def :: ToFields Int64 (Field SqlInt8)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Int64 -> Field SqlInt8
T.sqlInt8
instance D.Default ToFields Double (Field T.SqlFloat8) where
def :: ToFields Double (Field SqlFloat8)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Double -> Field SqlFloat8
T.sqlDouble
instance D.Default ToFields Bool (Field T.SqlBool) where
def :: ToFields Bool (Field SqlBool)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Bool -> Field SqlBool
T.sqlBool
instance D.Default ToFields UUID.UUID (Field T.SqlUuid) where
def :: ToFields UUID (Field SqlUuid)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields UUID -> Field SqlUuid
T.sqlUUID
instance D.Default ToFields Time.Day (Field T.SqlDate) where
def :: ToFields Day (Field SqlDate)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields Day -> Field SqlDate
T.sqlDay
instance D.Default ToFields Time.UTCTime (Field T.SqlTimestamptz) where
def :: ToFields UTCTime (Field SqlTimestamptz)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields UTCTime -> Field SqlTimestamptz
T.sqlUTCTime
instance D.Default ToFields Time.LocalTime (Field T.SqlTimestamp) where
def :: ToFields LocalTime (Field SqlTimestamp)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields LocalTime -> Field SqlTimestamp
T.sqlLocalTime
instance D.Default ToFields Time.ZonedTime (Field T.SqlTimestamptz) where
def :: ToFields ZonedTime (Field SqlTimestamptz)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ZonedTime -> Field SqlTimestamptz
T.sqlZonedTime
instance D.Default ToFields Time.TimeOfDay (Field T.SqlTime) where
def :: ToFields TimeOfDay (Field SqlTime)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields TimeOfDay -> Field SqlTime
T.sqlTimeOfDay
instance D.Default ToFields Time.CalendarDiffTime (Field T.SqlInterval) where
def :: ToFields CalendarDiffTime (Field SqlInterval)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields CalendarDiffTime -> Field SqlInterval
T.sqlInterval
instance D.Default ToFields (CI.CI ST.Text) (Field T.SqlCitext) where
def :: ToFields (CI Text) (Field SqlCitext)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields CI Text -> Field SqlCitext
T.sqlCiStrictText
instance D.Default ToFields (CI.CI LT.Text) (Field T.SqlCitext) where
def :: ToFields (CI Text) (Field SqlCitext)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields CI Text -> Field SqlCitext
T.sqlCiLazyText
instance D.Default ToFields SBS.ByteString (Field T.SqlJson) where
def :: ToFields ByteString (Field SqlJson)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlJson
T.sqlStrictJSON
instance D.Default ToFields LBS.ByteString (Field T.SqlJson) where
def :: ToFields ByteString (Field SqlJson)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlJson
T.sqlLazyJSON
instance D.Default ToFields Ae.Value (Field T.SqlJson) where
def :: ToFields Value (Field SqlJson)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a. ToJSON a => a -> Field SqlJson
T.sqlValueJSON
instance D.Default ToFields SBS.ByteString (Field T.SqlJsonb) where
def :: ToFields ByteString (Field SqlJsonb)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlJsonb
T.sqlStrictJSONB
instance D.Default ToFields LBS.ByteString (Field T.SqlJsonb) where
def :: ToFields ByteString (Field SqlJsonb)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields ByteString -> Field SqlJsonb
T.sqlLazyJSONB
instance (Ae.ToJSON a) => D.Default ToFields (Aeson a) (Field T.SqlJson) where
def :: ToFields (Aeson a) (Field SqlJson)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Field SqlJson
T.sqlValueJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Aeson a -> a
getAeson
instance D.Default ToFields Ae.Value (Field T.SqlJsonb) where
def :: ToFields Value (Field SqlJsonb)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a. ToJSON a => a -> Field SqlJsonb
T.sqlValueJSONB
instance D.Default ToFields haskell (F.Field_ n sql) => D.Default ToFields (Maybe haskell) (Maybe (F.Field_ n sql)) where
def :: ToFields (Maybe haskell) (Maybe (Field_ n sql))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields (forall haskells fields.
Default ToFields haskells fields =>
haskells -> fields
toFields forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
instance (Ae.ToJSON a) => D.Default ToFields (Aeson a) (F.Field T.SqlJsonb) where
def :: ToFields (Aeson a) (Field SqlJsonb)
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Field SqlJsonb
T.sqlValueJSONB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Aeson a -> a
getAeson
instance (D.Default ToFields a (F.Field_ n b), T.IsSqlType b)
=> D.Default ToFields [a] (F.Field (T.SqlArray_ n b)) where
def :: ToFields [a] (Field (SqlArray_ n b))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields (forall b a (n :: Nullability).
IsSqlType b =>
(a -> Field_ n b) -> [a] -> Field (SqlArray_ n b)
T.sqlArray (forall haskells fields.
ToFields haskells fields -> haskells -> fields
constantExplicit forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))
instance D.Default ToFields (R.PGRange Int.Int) (F.Field (T.SqlRange T.SqlInt4)) where
def :: ToFields (PGRange Int) (Field (SqlRange SqlInt4))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound Int
a RangeBound Int
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange Int -> Field SqlInt4
T.sqlInt4 RangeBound Int
a RangeBound Int
b
instance D.Default ToFields (R.PGRange Int.Int64) (F.Field (T.SqlRange T.SqlInt8)) where
def :: ToFields (PGRange Int64) (Field (SqlRange SqlInt8))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound Int64
a RangeBound Int64
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange Int64 -> Field SqlInt8
T.sqlInt8 RangeBound Int64
a RangeBound Int64
b
instance D.Default ToFields (R.PGRange Sci.Scientific) (F.Field (T.SqlRange T.SqlNumeric)) where
def :: ToFields (PGRange Scientific) (Field (SqlRange SqlNumeric))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound Scientific
a RangeBound Scientific
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange Scientific -> Field SqlNumeric
T.sqlNumeric RangeBound Scientific
a RangeBound Scientific
b
instance D.Default ToFields (R.PGRange Time.LocalTime) (F.Field (T.SqlRange T.SqlTimestamp)) where
def :: ToFields (PGRange LocalTime) (Field (SqlRange SqlTimestamp))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound LocalTime
a RangeBound LocalTime
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange LocalTime -> Field SqlTimestamp
T.sqlLocalTime RangeBound LocalTime
a RangeBound LocalTime
b
instance D.Default ToFields (R.PGRange Time.UTCTime) (F.Field (T.SqlRange T.SqlTimestamptz)) where
def :: ToFields (PGRange UTCTime) (Field (SqlRange SqlTimestamptz))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound UTCTime
a RangeBound UTCTime
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange UTCTime -> Field SqlTimestamptz
T.sqlUTCTime RangeBound UTCTime
a RangeBound UTCTime
b
instance D.Default ToFields (R.PGRange Time.Day) (F.Field (T.SqlRange T.SqlDate)) where
def :: ToFields (PGRange Day) (Field (SqlRange SqlDate))
def = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
toToFields forall a b. (a -> b) -> a -> b
$ \(R.PGRange RangeBound Day
a RangeBound Day
b) -> forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
T.sqlRange Day -> Field SqlDate
T.sqlDay RangeBound Day
a RangeBound Day
b
instance Functor (ToFields a) where
fmap :: forall a b. (a -> b) -> ToFields a a -> ToFields a b
fmap a -> b
f (ToFields a -> a
g) = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
g)
instance Applicative (ToFields a) where
pure :: forall a. a -> ToFields a a
pure = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
ToFields a -> a -> b
f <*> :: forall a b. ToFields a (a -> b) -> ToFields a a -> ToFields a b
<*> ToFields a -> a
x = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (a -> a -> b
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> a
x)
instance P.Profunctor ToFields where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> ToFields b c -> ToFields a d
dimap a -> b
f c -> d
g (ToFields b -> c
h) = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (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 b -> c
h)
instance PP.ProductProfunctor ToFields where
empty :: ToFields () ()
empty = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields forall (p :: * -> * -> *). ProductProfunctor p => p () ()
empty
ToFields a -> b
f ***! :: forall a b a' b'.
ToFields a b -> ToFields a' b' -> ToFields (a, a') (b, b')
***! ToFields a' -> b'
g = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (a -> b
f forall (p :: * -> * -> *) a b a' b'.
ProductProfunctor p =>
p a b -> p a' b' -> p (a, a') (b, b')
***! a' -> b'
g)
instance PP.SumProfunctor ToFields where
ToFields a -> b
f +++! :: forall a b a' b'.
ToFields a b
-> ToFields a' b' -> ToFields (Either a a') (Either b b')
+++! ToFields a' -> b'
g = forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
ToFields (a -> b
f forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
+++! a' -> b'
g)