{-# 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

-- | A way of turning Haskell values of type @haskells@ into SQL
-- fields.  Use it with 'Opaleye.ToFields.toFields'.
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

-- { Boilerplate instances

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)

-- }