{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
module Opaleye.Internal.Constant where
import Opaleye.Column (Column)
import qualified Opaleye.Column as C
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 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
toFields :: D.Default ToFields haskells fields
=> haskells -> fields
toFields = constantExplicit D.def
{-# DEPRECATED constant "Use 'toFields' instead. Will be removed in version 0.8." #-}
constant :: D.Default ToFields haskells fields
=> haskells -> fields
constant = constantExplicit D.def
newtype ToFields haskells fields =
ToFields { constantExplicit :: haskells -> fields }
{-# DEPRECATED Constant "Use 'ToFields' instead. Will be removed in version 0.8." #-}
type Constant = ToFields
instance D.Default ToFields haskell (Column sql)
=> D.Default ToFields (Maybe haskell) (Column (C.Nullable sql)) where
def = ToFields (C.maybeToNullable . fmap f)
where ToFields f = D.def
toToFields :: (haskells -> fields) -> ToFields haskells fields
toToFields = ToFields
instance D.Default ToFields (Column a) (Column a) where
def = toToFields id
instance D.Default ToFields String (Column T.SqlText) where
def = toToFields T.sqlString
instance D.Default ToFields LBS.ByteString (Column T.SqlBytea) where
def = toToFields T.sqlLazyByteString
instance D.Default ToFields SBS.ByteString (Column T.SqlBytea) where
def = toToFields T.sqlStrictByteString
instance D.Default ToFields ST.Text (Column T.SqlText) where
def = toToFields T.sqlStrictText
instance D.Default ToFields LT.Text (Column T.SqlText) where
def = toToFields T.sqlLazyText
instance D.Default ToFields Sci.Scientific (Column T.SqlNumeric) where
def = toToFields T.sqlNumeric
instance D.Default ToFields Int (Column T.SqlInt4) where
def = toToFields T.sqlInt4
instance D.Default ToFields Int.Int32 (Column T.SqlInt4) where
def = toToFields $ T.sqlInt4 . fromIntegral
instance D.Default ToFields Int.Int64 (Column T.SqlInt8) where
def = toToFields T.sqlInt8
instance D.Default ToFields Double (Column T.SqlFloat8) where
def = toToFields T.sqlDouble
instance D.Default ToFields Bool (Column T.SqlBool) where
def = toToFields T.sqlBool
instance D.Default ToFields UUID.UUID (Column T.SqlUuid) where
def = toToFields T.sqlUUID
instance D.Default ToFields Time.Day (Column T.SqlDate) where
def = toToFields T.sqlDay
instance D.Default ToFields Time.UTCTime (Column T.SqlTimestamptz) where
def = toToFields T.sqlUTCTime
instance D.Default ToFields Time.LocalTime (Column T.SqlTimestamp) where
def = toToFields T.sqlLocalTime
instance D.Default ToFields Time.ZonedTime (Column T.SqlTimestamptz) where
def = toToFields T.sqlZonedTime
instance D.Default ToFields Time.TimeOfDay (Column T.SqlTime) where
def = toToFields T.sqlTimeOfDay
instance D.Default ToFields (CI.CI ST.Text) (Column T.SqlCitext) where
def = toToFields T.sqlCiStrictText
instance D.Default ToFields (CI.CI LT.Text) (Column T.SqlCitext) where
def = toToFields T.sqlCiLazyText
instance D.Default ToFields SBS.ByteString (Column T.SqlJson) where
def = toToFields T.sqlStrictJSON
instance D.Default ToFields LBS.ByteString (Column T.SqlJson) where
def = toToFields T.sqlLazyJSON
instance D.Default ToFields Ae.Value (Column T.SqlJson) where
def = toToFields T.sqlValueJSON
instance D.Default ToFields SBS.ByteString (Column T.SqlJsonb) where
def = toToFields T.sqlStrictJSONB
instance D.Default ToFields LBS.ByteString (Column T.SqlJsonb) where
def = toToFields T.sqlLazyJSONB
instance D.Default ToFields Ae.Value (Column T.SqlJsonb) where
def = toToFields T.sqlValueJSONB
instance D.Default ToFields haskell (Column sql) => D.Default ToFields (Maybe haskell) (Maybe (Column sql)) where
def = toToFields (constant <$>)
instance (D.Default ToFields a (Column b), T.IsSqlType b)
=> D.Default ToFields [a] (Column (T.SqlArray b)) where
def = toToFields (T.sqlArray (constantExplicit D.def))
instance D.Default ToFields (R.PGRange Int.Int) (Column (T.SqlRange T.SqlInt4)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlInt4 a b
instance D.Default ToFields (R.PGRange Int.Int64) (Column (T.SqlRange T.SqlInt8)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlInt8 a b
instance D.Default ToFields (R.PGRange Sci.Scientific) (Column (T.SqlRange T.SqlNumeric)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlNumeric a b
instance D.Default ToFields (R.PGRange Time.LocalTime) (Column (T.SqlRange T.SqlTimestamp)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlLocalTime a b
instance D.Default ToFields (R.PGRange Time.UTCTime) (Column (T.SqlRange T.SqlTimestamptz)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlUTCTime a b
instance D.Default ToFields (R.PGRange Time.Day) (Column (T.SqlRange T.SqlDate)) where
def = toToFields $ \(R.PGRange a b) -> T.sqlRange T.sqlDay a b
instance Functor (ToFields a) where
fmap f (ToFields g) = ToFields (fmap f g)
instance Applicative (ToFields a) where
pure = ToFields . pure
ToFields f <*> ToFields x = ToFields (f <*> x)
instance P.Profunctor ToFields where
dimap f g (ToFields h) = ToFields (P.dimap f g h)
instance PP.ProductProfunctor ToFields where
empty = ToFields empty
ToFields f ***! ToFields g = ToFields (f ***! g)
instance PP.SumProfunctor ToFields where
ToFields f +++! ToFields g = ToFields (f +++! g)