{-# 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.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
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 a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> f (Expr a) -> f (Col Expr ('Spec labels 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 a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> (PrimExpr -> Expr a) -> PrimExpr -> Col Expr ('Spec labels 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 a))
-> f PrimExpr -> f (Col Expr ('Spec labels 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 a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels a))
 -> WrappedApplicative f (Col Expr ('Spec labels a)))
-> f (Col Expr ('Spec labels a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> (PrimExpr -> Expr a) -> PrimExpr -> Col Expr ('Spec labels 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 a))
-> f PrimExpr -> f (Col Expr ('Spec labels 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 => TableSchema names -> Opaleye.Table exprs exprs
table :: TableSchema names -> Table exprs exprs
table (TableSchema String
name Maybe String
schema names
columns) =
  case Maybe String
schema of
    Maybe String
Nothing -> String -> TableFields exprs exprs -> Table exprs exprs
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.Table String
name (names -> TableFields exprs exprs
forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)
    Just String
schemaName -> String -> String -> TableFields exprs exprs -> Table exprs exprs
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.TableWithSchema String
schemaName String
name (names -> TableFields exprs exprs
forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)


tableFields ::Selects names exprs
  => names -> Opaleye.TableFields exprs exprs
tableFields :: names -> TableFields exprs 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) = (exprs -> Columns exprs (Col Expr))
-> (Columns exprs (Col Expr) -> exprs)
-> TableFields
     (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
-> TableFields exprs exprs
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns Columns exprs (Col Expr) -> exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (TableFields (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
 -> TableFields exprs exprs)
-> TableFields
     (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
-> TableFields exprs exprs
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative
  (TableFields (Columns exprs (Col Expr))) (Columns exprs (Col Expr))
-> TableFields
     (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative
   (TableFields (Columns exprs (Col Expr))) (Columns exprs (Col Expr))
 -> TableFields
      (Columns exprs (Col Expr)) (Columns exprs (Col Expr)))
-> WrappedApplicative
     (TableFields (Columns exprs (Col Expr))) (Columns exprs (Col Expr))
-> TableFields
     (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns exprs) spec
 -> WrappedApplicative
      (TableFields (Columns exprs (Col Expr))) (Col Expr spec))
-> WrappedApplicative
     (TableFields (Columns exprs (Col Expr))) (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
       (TableFields (Columns exprs (Col Expr))) (Col Expr spec))
 -> WrappedApplicative
      (TableFields (Columns exprs (Col Expr)))
      (Columns exprs (Col Expr)))
-> (forall (spec :: Spec).
    HField (Columns exprs) spec
    -> WrappedApplicative
         (TableFields (Columns exprs (Col Expr))) (Col Expr spec))
-> WrappedApplicative
     (TableFields (Columns exprs (Col Expr))) (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) spec
field -> TableFields (Columns exprs (Col Expr)) (Col Expr spec)
-> WrappedApplicative
     (TableFields (Columns exprs (Col Expr))) (Col Expr spec)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (TableFields (Columns exprs (Col Expr)) (Col Expr spec)
 -> WrappedApplicative
      (TableFields (Columns exprs (Col Expr))) (Col Expr spec))
-> TableFields (Columns exprs (Col Expr)) (Col Expr spec)
-> WrappedApplicative
     (TableFields (Columns exprs (Col Expr))) (Col Expr spec)
forall a b. (a -> b) -> a -> b
$
    case Columns exprs (Col Name)
-> HField (Columns exprs) 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 exprs (Col Name)
names HField (Columns exprs) spec
field of
      Col Name spec
name -> (Columns exprs (Col Expr) -> Col Expr spec)
-> TableFields (Col Expr spec) (Col Expr spec)
-> TableFields (Columns exprs (Col Expr)) (Col Expr spec)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Columns exprs (Col Expr)
-> HField (Columns exprs) spec -> Col Expr spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
`hfield` HField (Columns exprs) spec
field) (Col Name spec -> TableFields (Col Expr spec) (Col Expr spec)
forall (spec :: Spec).
Col Name spec -> TableFields (Col Expr spec) (Col Expr spec)
go Col Name spec
name)
  where
    go :: Col Name spec -> Opaleye.TableFields (Col Expr spec) (Col Expr spec)
    go :: Col Name spec -> TableFields (Col Expr spec) (Col Expr spec)
go (N (Name name)) =
      (Col Expr spec -> Column Any)
-> TableFields (Column Any) (Col Expr ('Spec labels a))
-> TableFields (Col Expr spec) (Col Expr ('Spec labels a))
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(E 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 a))
 -> TableFields (Col Expr spec) (Col Expr ('Spec labels a)))
-> TableFields (Column Any) (Col Expr ('Spec labels a))
-> TableFields (Col Expr spec) (Col Expr ('Spec labels a))
forall a b. (a -> b) -> a -> b
$
        Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> (Column Any -> Expr a)
-> Column Any
-> Col Expr ('Spec labels 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 a))
-> TableFields (Column Any) (Column Any)
-> TableFields (Column Any) (Col Expr ('Spec labels 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


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 a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels a))
 -> WrappedApplicative f (Col Expr ('Spec labels a)))
-> f (Col Expr ('Spec labels a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> f (Expr a) -> f (Col Expr ('Spec labels 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 a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Col Expr ('Spec labels a))
 -> WrappedApplicative f (Col Expr ('Spec labels a)))
-> f (Col Expr ('Spec labels a))
-> WrappedApplicative f (Col Expr ('Spec labels a))
forall a b. (a -> b) -> a -> b
$ Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr a -> Col Expr ('Spec labels a))
-> f (Expr a) -> f (Col Expr ('Spec labels 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) a.
SSpec ('Spec labels a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> 
      case Columns a (Col Expr)
-> HField (Columns a) ('Spec labels a) -> Col Expr ('Spec labels 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 a)
i of
        E expr ->
          Expr a -> Col Expr ('Spec labels a)
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels 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)