{-# language BlockArguments #-}
{-# language DisambiguateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

module Rel8.Table.Opaleye
  ( aggregator
  , binaryspec
  , distinctspec
  , table
  , tableFields
  , unpackspec
  , valuesspec
  , castTable
  )
where

-- base
import Prelude hiding ( undefined )

-- opaleye
import qualified Opaleye.Internal.Aggregate as Opaleye
import qualified Opaleye.Internal.Binary as Opaleye
import qualified Opaleye.Internal.Distinct as Opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.Unpackspec as Opaleye
import qualified Opaleye.Internal.Values as Opaleye
import qualified Opaleye.Internal.Table as Opaleye

-- profunctors
import Data.Profunctor ( dimap, lmap )

-- rel8
import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ), Aggregates )
import Rel8.Expr ( Expr, Col(..) )
import Rel8.Expr.Opaleye
  ( fromPrimExpr, toPrimExpr
  , traversePrimExpr
  , fromColumn, toColumn
  , scastExpr
  )
import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )
import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
import Rel8.Schema.Insert ( Col( I ), Create(..), Insert, Inserts )
import Rel8.Schema.Name ( Col( N ), Name( Name ), Selects )
import Rel8.Schema.Spec ( SSpec(..) )
import Rel8.Schema.Table ( TableSchema(..) )
import Rel8.Table ( Table, fromColumns, toColumns )
import Rel8.Table.Undefined ( undefined )

-- semigroupoids
import Data.Functor.Apply ( WrappedApplicative(..) )


aggregator :: Aggregates aggregates exprs => Opaleye.Aggregator aggregates exprs
aggregator :: Aggregator aggregates exprs
aggregator = PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  PrimExpr
  aggregates
  exprs
-> Aggregator aggregates exprs
forall a b.
PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
Opaleye.Aggregator (PackMap
   (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   PrimExpr
   aggregates
   exprs
 -> Aggregator aggregates exprs)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     aggregates
     exprs
-> Aggregator aggregates exprs
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> f PrimExpr)
 -> aggregates -> f exprs)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     aggregates
     exprs
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   -> f PrimExpr)
  -> aggregates -> f exprs)
 -> PackMap
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
      PrimExpr
      aggregates
      exprs)
-> (forall (f :: * -> *).
    Applicative f =>
    ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     -> f PrimExpr)
    -> aggregates -> f exprs)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     aggregates
     exprs
forall a b. (a -> b) -> a -> b
$ \(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f aggregates
aggregates ->
  (Columns exprs (Col Expr) -> exprs)
-> f (Columns exprs (Col Expr)) -> f exprs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns exprs (Col Expr) -> exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (f (Columns exprs (Col Expr)) -> f exprs)
-> f (Columns exprs (Col Expr)) -> f exprs
forall a b. (a -> b) -> a -> b
$ WrappedApplicative f (Columns exprs (Col Expr))
-> f (Columns exprs (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns exprs (Col Expr))
 -> f (Columns exprs (Col Expr)))
-> WrappedApplicative f (Columns exprs (Col Expr))
-> f (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns exprs) spec
 -> WrappedApplicative f (Col Expr spec))
-> WrappedApplicative f (Columns exprs (Col Expr))
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA ((forall (spec :: Spec).
  HField (Columns exprs) spec
  -> WrappedApplicative f (Col Expr spec))
 -> WrappedApplicative f (Columns exprs (Col Expr)))
-> (forall (spec :: Spec).
    HField (Columns exprs) spec
    -> WrappedApplicative f (Col Expr spec))
-> WrappedApplicative f (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) spec
field ->
    f (Col Expr spec) -> WrappedApplicative f (Col Expr spec)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr spec) -> WrappedApplicative f (Col Expr spec))
-> f (Col Expr spec) -> WrappedApplicative f (Col Expr spec)
forall a b. (a -> b) -> a -> b
$ case Columns exprs (Col Aggregate)
-> HField (Columns exprs) spec -> Col Aggregate spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (aggregates -> Columns aggregates (Col Aggregate)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns aggregates
aggregates) HField (Columns exprs) spec
field of
      A (Aggregate (Opaleye.Aggregator (Opaleye.PackMap inner))) ->
        Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> f (Expr a) -> f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
inner (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f ()


binaryspec :: Table Expr a => Opaleye.Binaryspec a a
binaryspec :: Binaryspec a a
binaryspec = PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a -> Binaryspec a a
forall columns columns'.
PackMap (PrimExpr, PrimExpr) PrimExpr (columns, columns) columns'
-> Binaryspec columns columns'
Opaleye.Binaryspec (PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a -> Binaryspec a a)
-> PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a -> Binaryspec a a
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((PrimExpr, PrimExpr) -> f PrimExpr) -> (a, a) -> f a)
-> PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((PrimExpr, PrimExpr) -> f PrimExpr) -> (a, a) -> f a)
 -> PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a)
-> (forall (f :: * -> *).
    Applicative f =>
    ((PrimExpr, PrimExpr) -> f PrimExpr) -> (a, a) -> f a)
-> PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a
forall a b. (a -> b) -> a -> b
$ \(PrimExpr, PrimExpr) -> f PrimExpr
f (as, bs) ->
  (Columns a (Col Expr) -> a) -> f (Columns a (Col Expr)) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (f (Columns a (Col Expr)) -> f a)
-> f (Columns a (Col Expr)) -> f a
forall a b. (a -> b) -> a -> b
$ WrappedApplicative f (Columns a (Col Expr))
-> f (Columns a (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a (Col Expr))
 -> f (Columns a (Col Expr)))
-> WrappedApplicative f (Columns a (Col Expr))
-> f (Columns a (Col Expr))
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns a) spec -> WrappedApplicative f (Col Expr spec))
-> WrappedApplicative f (Columns a (Col Expr))
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA ((forall (spec :: Spec).
  HField (Columns a) spec -> WrappedApplicative f (Col Expr spec))
 -> WrappedApplicative f (Columns a (Col Expr)))
-> (forall (spec :: Spec).
    HField (Columns a) spec -> WrappedApplicative f (Col Expr spec))
-> WrappedApplicative f (Columns a (Col Expr))
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) spec
field ->
    f (Col Expr spec) -> WrappedApplicative f (Col Expr spec)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr spec) -> WrappedApplicative f (Col Expr spec))
-> f (Col Expr spec) -> WrappedApplicative f (Col Expr spec)
forall a b. (a -> b) -> a -> b
$
      case (Columns a (Col Expr) -> HField (Columns a) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns a
as) HField (Columns a) spec
field, Columns a (Col Expr) -> HField (Columns a) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield (a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns a
bs) HField (Columns a) spec
field) of
        (E a, E b) -> Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> (PrimExpr -> Expr a)
-> PrimExpr
-> Col Expr ('Spec labels necessity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Col Expr ('Spec labels necessity a))
-> f PrimExpr -> f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimExpr, PrimExpr) -> f PrimExpr
f (Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
a, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
b)


distinctspec :: Table Expr a => Opaleye.Distinctspec a a
distinctspec :: Distinctspec a a
distinctspec =
  Aggregator a a -> Distinctspec a a
forall a b. Aggregator a b -> Distinctspec a b
Opaleye.Distinctspec (Aggregator a a -> Distinctspec a a)
-> Aggregator a a -> Distinctspec a a
forall a b. (a -> b) -> a -> b
$ PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a
-> Aggregator a a
forall a b.
PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
Opaleye.Aggregator (PackMap
   (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a
 -> Aggregator a a)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a
-> Aggregator a a
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> f PrimExpr)
 -> a -> f a)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   -> f PrimExpr)
  -> a -> f a)
 -> PackMap
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a)
-> (forall (f :: * -> *).
    Applicative f =>
    ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     -> f PrimExpr)
    -> a -> f a)
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a a
forall a b. (a -> b) -> a -> b
$ \(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f ->
    (Columns a (Col Expr) -> a) -> f (Columns a (Col Expr)) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (f (Columns a (Col Expr)) -> f a)
-> (a -> f (Columns a (Col Expr))) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    WrappedApplicative f (Columns a (Col Expr))
-> f (Columns a (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a (Col Expr))
 -> f (Columns a (Col Expr)))
-> (a -> WrappedApplicative f (Columns a (Col Expr)))
-> a
-> f (Columns a (Col Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (spec :: Spec).
 Col Expr spec -> WrappedApplicative f (Col Expr spec))
-> Columns a (Col Expr)
-> WrappedApplicative f (Columns a (Col Expr))
forall (t :: HTable) (m :: * -> *) (f :: HContext) (g :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). f spec -> m (g spec)) -> t f -> m (t g)
htraverse
      (\(E a) ->
         f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels necessity a))
 -> WrappedApplicative f (Col Expr ('Spec labels necessity a)))
-> f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> (PrimExpr -> Expr a)
-> PrimExpr
-> Col Expr ('Spec labels necessity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Col Expr ('Spec labels necessity a))
-> f PrimExpr -> f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f (Maybe (AggrOp, [OrderExpr], AggrDistinct)
forall a. Maybe a
Nothing, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
a)) (Columns a (Col Expr)
 -> WrappedApplicative f (Columns a (Col Expr)))
-> (a -> Columns a (Col Expr))
-> a
-> WrappedApplicative f (Columns a (Col Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns


table ::(Selects names exprs, Inserts exprs inserts)
  => TableSchema names -> Opaleye.Table inserts exprs
table :: TableSchema names -> Table inserts exprs
table (TableSchema String
name Maybe String
schema names
columns) =
  case Maybe String
schema of
    Maybe String
Nothing -> String -> TableFields inserts exprs -> Table inserts exprs
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.Table String
name (names -> TableFields inserts exprs
forall names exprs inserts.
(Selects names exprs, Inserts exprs inserts) =>
names -> TableFields inserts exprs
tableFields names
columns)
    Just String
schemaName -> String
-> String -> TableFields inserts exprs -> Table inserts exprs
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.TableWithSchema String
schemaName String
name (names -> TableFields inserts exprs
forall names exprs inserts.
(Selects names exprs, Inserts exprs inserts) =>
names -> TableFields inserts exprs
tableFields names
columns)


tableFields :: (Selects names exprs, Inserts exprs inserts)
  => names -> Opaleye.TableFields inserts exprs
tableFields :: names -> TableFields inserts exprs
tableFields (names -> Columns names (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns names (Col Name)
names) = (inserts -> Columns inserts (Col Insert))
-> (Columns inserts (Col Expr) -> exprs)
-> TableFields
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
-> TableFields inserts exprs
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap inserts -> Columns inserts (Col Insert)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns Columns inserts (Col Expr) -> exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (TableFields
   (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
 -> TableFields inserts exprs)
-> TableFields
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
-> TableFields inserts exprs
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative
  (TableFields (Columns inserts (Col Insert)))
  (Columns inserts (Col Expr))
-> TableFields
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative
   (TableFields (Columns inserts (Col Insert)))
   (Columns inserts (Col Expr))
 -> TableFields
      (Columns inserts (Col Insert)) (Columns inserts (Col Expr)))
-> WrappedApplicative
     (TableFields (Columns inserts (Col Insert)))
     (Columns inserts (Col Expr))
-> TableFields
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns inserts) spec
 -> WrappedApplicative
      (TableFields (Columns inserts (Col Insert))) (Col Expr spec))
-> WrappedApplicative
     (TableFields (Columns inserts (Col Insert)))
     (Columns inserts (Col Expr))
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA ((forall (spec :: Spec).
  HField (Columns inserts) spec
  -> WrappedApplicative
       (TableFields (Columns inserts (Col Insert))) (Col Expr spec))
 -> WrappedApplicative
      (TableFields (Columns inserts (Col Insert)))
      (Columns inserts (Col Expr)))
-> (forall (spec :: Spec).
    HField (Columns inserts) spec
    -> WrappedApplicative
         (TableFields (Columns inserts (Col Insert))) (Col Expr spec))
-> WrappedApplicative
     (TableFields (Columns inserts (Col Insert)))
     (Columns inserts (Col Expr))
forall a b. (a -> b) -> a -> b
$ \HField (Columns inserts) spec
field -> TableFields (Columns inserts (Col Insert)) (Col Expr spec)
-> WrappedApplicative
     (TableFields (Columns inserts (Col Insert))) (Col Expr spec)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (TableFields (Columns inserts (Col Insert)) (Col Expr spec)
 -> WrappedApplicative
      (TableFields (Columns inserts (Col Insert))) (Col Expr spec))
-> TableFields (Columns inserts (Col Insert)) (Col Expr spec)
-> WrappedApplicative
     (TableFields (Columns inserts (Col Insert))) (Col Expr spec)
forall a b. (a -> b) -> a -> b
$
    case Columns inserts SSpec
-> HField (Columns inserts) spec -> SSpec spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns inserts SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField (Columns inserts) spec
field of
      SSpec spec
specs -> case Columns inserts (Col Name)
-> HField (Columns inserts) spec -> Col Name spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns names (Col Name)
Columns inserts (Col Name)
names HField (Columns inserts) spec
field of
        Col Name spec
name -> (Columns inserts (Col Insert) -> Col Insert spec)
-> TableFields (Col Insert spec) (Col Expr spec)
-> TableFields (Columns inserts (Col Insert)) (Col Expr spec)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Columns inserts (Col Insert)
-> HField (Columns inserts) spec -> Col Insert spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
`hfield` HField (Columns inserts) spec
field) (SSpec spec
-> Col Name spec -> TableFields (Col Insert spec) (Col Expr spec)
forall (spec :: Spec).
SSpec spec
-> Col Name spec -> TableFields (Col Insert spec) (Col Expr spec)
go SSpec spec
specs Col Name spec
name)
  where
    go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
    go :: SSpec spec
-> Col Name spec -> TableFields (Col Insert spec) (Col Expr spec)
go SSpec {SNecessity necessity
necessity :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> SNecessity necessity
necessity :: SNecessity necessity
necessity} (N (Name name)) = case SNecessity necessity
necessity of
      SNecessity necessity
SRequired ->
        (Col Insert spec -> Column Any)
-> TableFields (Column Any) (Col Expr ('Spec labels 'Required a))
-> TableFields
     (Col Insert spec) (Col Expr ('Spec labels 'Required a))
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(I (Value a)) -> PrimExpr -> Column Any
forall b. PrimExpr -> Column b
toColumn (PrimExpr -> Column Any) -> PrimExpr -> Column Any
forall a b. (a -> b) -> a -> b
$ Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
a) (TableFields (Column Any) (Col Expr ('Spec labels 'Required a))
 -> TableFields
      (Col Insert spec) (Col Expr ('Spec labels 'Required a)))
-> TableFields (Column Any) (Col Expr ('Spec labels 'Required a))
-> TableFields
     (Col Insert spec) (Col Expr ('Spec labels 'Required a))
forall a b. (a -> b) -> a -> b
$
        Expr a -> Col Expr ('Spec labels 'Required a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels 'Required a))
-> (Column Any -> Expr a)
-> Column Any
-> Col Expr ('Spec labels 'Required a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (Column Any -> PrimExpr) -> Column Any -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column Any -> PrimExpr
forall b. Column b -> PrimExpr
fromColumn (Column Any -> Col Expr ('Spec labels 'Required a))
-> TableFields (Column Any) (Column Any)
-> TableFields (Column Any) (Col Expr ('Spec labels 'Required a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          String -> TableFields (Column Any) (Column Any)
forall a. String -> TableFields (Column a) (Column a)
Opaleye.requiredTableField String
name
      SNecessity necessity
SOptional ->
        (Col Insert spec -> Maybe (Column Any))
-> TableFields
     (Maybe (Column Any)) (Col Expr ('Spec labels 'Optional a))
-> TableFields
     (Col Insert spec) (Col Expr ('Spec labels 'Optional a))
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(I ma) -> PrimExpr -> Column Any
forall b. PrimExpr -> Column b
toColumn (PrimExpr -> Column Any)
-> (Expr a -> PrimExpr) -> Expr a -> Column Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr (Expr a -> Column Any) -> Maybe (Expr a) -> Maybe (Column Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Create necessity a -> Maybe (Expr a)
forall (necessity :: Necessity) a.
Create necessity a -> Maybe (Expr a)
fromInsert Create necessity a
ma) (TableFields
   (Maybe (Column Any)) (Col Expr ('Spec labels 'Optional a))
 -> TableFields
      (Col Insert spec) (Col Expr ('Spec labels 'Optional a)))
-> TableFields
     (Maybe (Column Any)) (Col Expr ('Spec labels 'Optional a))
-> TableFields
     (Col Insert spec) (Col Expr ('Spec labels 'Optional a))
forall a b. (a -> b) -> a -> b
$
        Expr a -> Col Expr ('Spec labels 'Optional a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels 'Optional a))
-> (Column Any -> Expr a)
-> Column Any
-> Col Expr ('Spec labels 'Optional a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (Column Any -> PrimExpr) -> Column Any -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column Any -> PrimExpr
forall b. Column b -> PrimExpr
fromColumn (Column Any -> Col Expr ('Spec labels 'Optional a))
-> TableFields (Maybe (Column Any)) (Column Any)
-> TableFields
     (Maybe (Column Any)) (Col Expr ('Spec labels 'Optional a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          String -> TableFields (Maybe (Column Any)) (Column Any)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
Opaleye.optionalTableField String
name
      where
        fromInsert :: Create necessity a -> Maybe (Expr a)
fromInsert = \case
          Create necessity a
Default -> Maybe (Expr a)
forall a. Maybe a
Nothing
          Value Expr a
a -> Expr a -> Maybe (Expr a)
forall a. a -> Maybe a
Just Expr a
a


unpackspec :: Table Expr a => Opaleye.Unpackspec a a
unpackspec :: Unpackspec a a
unpackspec = PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Opaleye.Unpackspec (PackMap PrimExpr PrimExpr a a -> Unpackspec a a)
-> PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (PrimExpr -> f PrimExpr) -> a -> f a)
-> PackMap PrimExpr PrimExpr a a
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: * -> *).
  Applicative f =>
  (PrimExpr -> f PrimExpr) -> a -> f a)
 -> PackMap PrimExpr PrimExpr a a)
-> (forall (f :: * -> *).
    Applicative f =>
    (PrimExpr -> f PrimExpr) -> a -> f a)
-> PackMap PrimExpr PrimExpr a a
forall a b. (a -> b) -> a -> b
$ \PrimExpr -> f PrimExpr
f ->
  (Columns a (Col Expr) -> a) -> f (Columns a (Col Expr)) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (f (Columns a (Col Expr)) -> f a)
-> (a -> f (Columns a (Col Expr))) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  WrappedApplicative f (Columns a (Col Expr))
-> f (Columns a (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a (Col Expr))
 -> f (Columns a (Col Expr)))
-> (a -> WrappedApplicative f (Columns a (Col Expr)))
-> a
-> f (Columns a (Col Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall (spec :: Spec).
 Col Expr spec -> WrappedApplicative f (Col Expr spec))
-> Columns a (Col Expr)
-> WrappedApplicative f (Columns a (Col Expr))
forall (t :: HTable) (m :: * -> *) (f :: HContext) (g :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). f spec -> m (g spec)) -> t f -> m (t g)
htraverse (\(E a) -> f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels necessity a))
 -> WrappedApplicative f (Col Expr ('Spec labels necessity a)))
-> f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> f (Expr a) -> f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimExpr -> f PrimExpr) -> Expr a -> f (Expr a)
forall (f :: * -> *) a b.
Functor f =>
(PrimExpr -> f PrimExpr) -> Expr a -> f (Expr b)
traversePrimExpr PrimExpr -> f PrimExpr
f Expr a
a) (Columns a (Col Expr)
 -> WrappedApplicative f (Columns a (Col Expr)))
-> (a -> Columns a (Col Expr))
-> a
-> WrappedApplicative f (Columns a (Col Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns
{-# INLINABLE unpackspec #-}


valuesspec :: Table Expr a => Opaleye.ValuesspecSafe a a
valuesspec :: ValuesspecSafe a a
valuesspec = PackMap PrimExpr PrimExpr () a
-> Unpackspec a a -> ValuesspecSafe a a
forall columns columns'.
PackMap PrimExpr PrimExpr () columns'
-> Unpackspec columns columns' -> Valuesspec columns columns'
Opaleye.ValuesspecSafe (a -> PackMap PrimExpr PrimExpr () a
forall a. Table Expr a => a -> PackMap PrimExpr PrimExpr () a
toPackMap a
forall a. Table Expr a => a
undefined) Unpackspec a a
forall a. Table Expr a => Unpackspec a a
unpackspec


toPackMap :: Table Expr a
  => a -> Opaleye.PackMap Opaleye.PrimExpr Opaleye.PrimExpr () a
toPackMap :: a -> PackMap PrimExpr PrimExpr () a
toPackMap a
as = (forall (f :: * -> *).
 Applicative f =>
 (PrimExpr -> f PrimExpr) -> () -> f a)
-> PackMap PrimExpr PrimExpr () a
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: * -> *).
  Applicative f =>
  (PrimExpr -> f PrimExpr) -> () -> f a)
 -> PackMap PrimExpr PrimExpr () a)
-> (forall (f :: * -> *).
    Applicative f =>
    (PrimExpr -> f PrimExpr) -> () -> f a)
-> PackMap PrimExpr PrimExpr () a
forall a b. (a -> b) -> a -> b
$ \PrimExpr -> f PrimExpr
f () ->
  (Columns a (Col Expr) -> a) -> f (Columns a (Col Expr)) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (f (Columns a (Col Expr)) -> f a)
-> f (Columns a (Col Expr)) -> f a
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative f (Columns a (Col Expr))
-> f (Columns a (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a (Col Expr))
 -> f (Columns a (Col Expr)))
-> (Columns a (Col Expr)
    -> WrappedApplicative f (Columns a (Col Expr)))
-> Columns a (Col Expr)
-> f (Columns a (Col Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall (spec :: Spec).
 Col Expr spec -> WrappedApplicative f (Col Expr spec))
-> Columns a (Col Expr)
-> WrappedApplicative f (Columns a (Col Expr))
forall (t :: HTable) (m :: * -> *) (f :: HContext) (g :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). f spec -> m (g spec)) -> t f -> m (t g)
htraverse (\(E a) -> f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels necessity a))
 -> WrappedApplicative f (Col Expr ('Spec labels necessity a)))
-> f (Col Expr ('Spec labels necessity a))
-> WrappedApplicative f (Col Expr ('Spec labels necessity a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> f (Expr a) -> f (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimExpr -> f PrimExpr) -> Expr a -> f (Expr a)
forall (f :: * -> *) a b.
Functor f =>
(PrimExpr -> f PrimExpr) -> Expr a -> f (Expr b)
traversePrimExpr PrimExpr -> f PrimExpr
f Expr a
a) (Columns a (Col Expr) -> f (Columns a (Col Expr)))
-> Columns a (Col Expr) -> f (Columns a (Col Expr))
forall a b. (a -> b) -> a -> b
$
  a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns a
as


-- | Transform a table by adding 'CAST' to all columns. This is most useful for
-- finalising a SELECT or RETURNING statement, guaranteed that the output
-- matches what is encoded in each columns TypeInformation.
castTable :: Table Expr a => a -> a
castTable :: a -> a
castTable (a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns a (Col Expr)
as) = Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns a (Col Expr) -> a) -> Columns a (Col Expr) -> a
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec). HField (Columns a) spec -> Col Expr spec)
-> Columns a (Col Expr)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (spec :: Spec). HField t spec -> context spec) -> t context
htabulate \HField (Columns a) spec
i ->
  case Columns a SSpec -> HField (Columns a) spec -> SSpec spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a SSpec
forall (t :: HTable). HTable t => t SSpec
hspecs HField (Columns a) spec
i of
    SSpec{TypeInformation (Unnullify a)
info :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> 
      case Columns a (Col Expr)
-> HField (Columns a) ('Spec labels necessity a)
-> Col Expr ('Spec labels necessity a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns a (Col Expr)
as HField (Columns a) spec
HField (Columns a) ('Spec labels necessity a)
i of
        E expr ->
          Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (TypeInformation (Unnullify a) -> Expr a -> Expr a
forall a. TypeInformation (Unnullify a) -> Expr a -> Expr a
scastExpr TypeInformation (Unnullify a)
TypeInformation (Unnullify a)
info Expr a
expr)