{-# language BlockArguments #-}
{-# language DataKinds #-}
{-# language DisambiguateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

{-# options_ghc -Wno-deprecations #-}

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

-- base
import Data.Functor.Const ( Const( Const ), getConst )
import Data.List.NonEmpty ( NonEmpty )
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 ( Aggregate( Aggregate ), Aggregates )
import Rel8.Expr ( Expr )
import Rel8.Expr.Opaleye
  ( fromPrimExpr, toPrimExpr
  , traversePrimExpr
  , fromColumn, toColumn
  , scastExpr
  )
import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
import Rel8.Schema.Name ( Name( Name ), Selects, ppColumn )
import Rel8.Schema.Spec ( Spec(..) )
import Rel8.Schema.Table ( TableSchema(..), ppTable )
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 Expr -> exprs) -> f (Columns exprs Expr) -> f exprs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (f (Columns exprs Expr) -> f exprs)
-> f (Columns exprs Expr) -> f exprs
forall a b. (a -> b) -> a -> b
$ WrappedApplicative f (Columns exprs Expr) -> f (Columns exprs Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns exprs Expr)
 -> f (Columns exprs Expr))
-> WrappedApplicative f (Columns exprs Expr)
-> f (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns exprs) a -> WrappedApplicative f (Expr a))
-> WrappedApplicative f (Columns exprs Expr)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns exprs) a -> WrappedApplicative f (Expr a))
 -> WrappedApplicative f (Columns exprs Expr))
-> (forall a.
    HField (Columns exprs) a -> WrappedApplicative f (Expr a))
-> WrappedApplicative f (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
    f (Expr a) -> WrappedApplicative f (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Expr a) -> WrappedApplicative f (Expr a))
-> f (Expr a) -> WrappedApplicative f (Expr a)
forall a b. (a -> b) -> a -> b
$ case Columns exprs Aggregate -> HField (Columns exprs) a -> Aggregate a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (aggregates -> Columns aggregates Aggregate
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns aggregates
aggregates) HField (Columns exprs) a
field of
      Aggregate (Opaleye.Aggregator (Opaleye.PackMap forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
inner)) ->
        ((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 ()


attributes :: Selects names exprs => TableSchema names -> exprs
attributes :: TableSchema names -> exprs
attributes schema :: TableSchema names
schema@TableSchema {names
columns :: forall names. TableSchema names -> names
columns :: names
columns} = Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns exprs Expr -> exprs) -> Columns exprs Expr -> exprs
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns exprs) a -> Expr a)
 -> Columns exprs Expr)
-> (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
    Name String
column -> PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> Literal -> PrimExpr
forall a b. (a -> b) -> a -> b
$
      String -> Literal
Opaleye.OtherLit (String -> Literal) -> String -> Literal
forall a b. (a -> b) -> a -> b
$
        Doc -> String
forall a. Show a => a -> String
show (TableSchema names -> Doc
forall a. TableSchema a -> Doc
ppTable TableSchema names
schema) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc -> String
forall a. Show a => a -> String
show (String -> Doc
ppColumn String
column)


binaryspec :: Table Expr a => Opaleye.Binaryspec a a
binaryspec :: Binaryspec a a
binaryspec = PackMap (PrimExpr, PrimExpr) PrimExpr (a, a) a -> Binaryspec a a
forall fields fields'.
PackMap (PrimExpr, PrimExpr) PrimExpr (fields, fields) fields'
-> Binaryspec fields fields'
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 Expr -> a) -> f (Columns a Expr) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (f (Columns a Expr) -> f a) -> f (Columns a Expr) -> f a
forall a b. (a -> b) -> a -> b
$ WrappedApplicative f (Columns a Expr) -> f (Columns a Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a Expr) -> f (Columns a Expr))
-> WrappedApplicative f (Columns a Expr) -> f (Columns a Expr)
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns a) a -> WrappedApplicative f (Expr a))
-> WrappedApplicative f (Columns a Expr)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a. HField (Columns a) a -> WrappedApplicative f (Expr a))
 -> WrappedApplicative f (Columns a Expr))
-> (forall a.
    HField (Columns a) a -> WrappedApplicative f (Expr a))
-> WrappedApplicative f (Columns a Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
    f (Expr a) -> WrappedApplicative f (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Expr a) -> WrappedApplicative f (Expr a))
-> f (Expr a) -> WrappedApplicative f (Expr a)
forall a b. (a -> b) -> a -> b
$
      case (Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns a
as) HField (Columns a) a
field, Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns a
bs) HField (Columns a) a
field) of
        (Expr a
a, Expr a
b) -> PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> f PrimExpr -> f (Expr 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 Expr -> a) -> f (Columns a Expr) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (f (Columns a Expr) -> f a)
-> (a -> f (Columns a Expr)) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    WrappedApplicative f (Columns a Expr) -> f (Columns a Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a Expr) -> f (Columns a Expr))
-> (a -> WrappedApplicative f (Columns a Expr))
-> a
-> f (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall a. Expr a -> WrappedApplicative f (Expr a))
-> Columns a Expr -> WrappedApplicative f (Columns a Expr)
forall (t :: HTable) (m :: * -> *) (f :: * -> *) (g :: * -> *).
(HTable t, Apply m) =>
(forall a. f a -> m (g a)) -> t f -> m (t g)
htraverse
      (\Expr a
a -> f (Expr a) -> WrappedApplicative f (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Expr a) -> WrappedApplicative f (Expr a))
-> f (Expr a) -> WrappedApplicative f (Expr a)
forall a b. (a -> b) -> a -> b
$ PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> f PrimExpr -> f (Expr 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 Expr -> WrappedApplicative f (Columns a Expr))
-> (a -> Columns a Expr)
-> a
-> WrappedApplicative f (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns


exprs :: Table Expr a => a -> NonEmpty Opaleye.PrimExpr
exprs :: a -> NonEmpty PrimExpr
exprs (a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr
forall a k (b :: k). Const a b -> a
getConst (Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr)
-> Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
-> Const (NonEmpty PrimExpr) (Columns a Any)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
 -> Const (NonEmpty PrimExpr) (Columns a Any))
-> (forall a.
    HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
-> Const (NonEmpty PrimExpr) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
  case Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field of
    Expr a
expr -> NonEmpty PrimExpr -> Const (NonEmpty PrimExpr) (Any a)
forall k a (b :: k). a -> Const a b
Const (PrimExpr -> NonEmpty PrimExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))


exprsWithNames :: Selects names exprs
  => names -> exprs -> NonEmpty (String, Opaleye.PrimExpr)
exprsWithNames :: names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names exprs
as = Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
-> NonEmpty (String, PrimExpr)
forall a k (b :: k). Const a b -> a
getConst (Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
 -> NonEmpty (String, PrimExpr))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
-> NonEmpty (String, PrimExpr)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns exprs) a
 -> Const (NonEmpty (String, PrimExpr)) (Any a))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns exprs) a
  -> Const (NonEmpty (String, PrimExpr)) (Any a))
 -> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any))
-> (forall a.
    HField (Columns exprs) a
    -> Const (NonEmpty (String, PrimExpr)) (Any a))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case (Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
names) HField (Columns exprs) a
field, Columns exprs Expr -> HField (Columns exprs) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (exprs -> Columns exprs Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns exprs
as) HField (Columns exprs) a
field) of
    (Name String
name, Expr a
expr) -> NonEmpty (String, PrimExpr)
-> Const (NonEmpty (String, PrimExpr)) (Any a)
forall k a (b :: k). a -> Const a b
Const ((String, PrimExpr) -> NonEmpty (String, PrimExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))


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 Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns names Name
names) = (exprs -> Columns exprs Expr)
-> (Columns exprs Expr -> exprs)
-> TableFields (Columns exprs Expr) (Columns exprs 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 Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (TableFields (Columns exprs Expr) (Columns exprs Expr)
 -> TableFields exprs exprs)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
-> TableFields exprs exprs
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative
  (TableFields (Columns exprs Expr)) (Columns exprs Expr)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative
   (TableFields (Columns exprs Expr)) (Columns exprs Expr)
 -> TableFields (Columns exprs Expr) (Columns exprs Expr))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns exprs) a
 -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns exprs) a
  -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
 -> WrappedApplicative
      (TableFields (Columns exprs Expr)) (Columns exprs Expr))
-> (forall a.
    HField (Columns exprs) a
    -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field -> TableFields (Columns exprs Expr) (Expr a)
-> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (TableFields (Columns exprs Expr) (Expr a)
 -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> TableFields (Columns exprs Expr) (Expr a)
-> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a)
forall a b. (a -> b) -> a -> b
$
    case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns names Name
Columns exprs Name
names HField (Columns exprs) a
field of
      Name a
name -> (Columns exprs Expr -> Expr a)
-> TableFields (Expr a) (Expr a)
-> TableFields (Columns exprs Expr) (Expr a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Columns exprs Expr -> HField (Columns exprs) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns exprs) a
field) (Name a -> TableFields (Expr a) (Expr a)
forall a. Name a -> TableFields (Expr a) (Expr a)
go Name a
name)
  where
    go :: Name a -> Opaleye.TableFields (Expr a) (Expr a)
    go :: Name a -> TableFields (Expr a) (Expr a)
go (Name String
name) =
      (Expr a -> Field_ Any Any)
-> (Field_ Any Any -> Expr a)
-> TableFields (Field_ Any Any) (Field_ Any Any)
-> TableFields (Expr a) (Expr a)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (PrimExpr -> Field_ Any Any
forall (n :: Nullability) b. PrimExpr -> Field_ n b
toColumn (PrimExpr -> Field_ Any Any)
-> (Expr a -> PrimExpr) -> Expr a -> Field_ Any Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr) (PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (Field_ Any Any -> PrimExpr) -> Field_ Any Any -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ Any Any -> PrimExpr
forall (n :: Nullability) b. Field_ n b -> PrimExpr
fromColumn) (TableFields (Field_ Any Any) (Field_ Any Any)
 -> TableFields (Expr a) (Expr a))
-> TableFields (Field_ Any Any) (Field_ Any Any)
-> TableFields (Expr a) (Expr a)
forall a b. (a -> b) -> a -> b
$
        String -> TableFields (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a.
String -> TableFields (Field_ n a) (Field_ n 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 fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
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 Expr -> a) -> f (Columns a Expr) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (f (Columns a Expr) -> f a)
-> (a -> f (Columns a Expr)) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  WrappedApplicative f (Columns a Expr) -> f (Columns a Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a Expr) -> f (Columns a Expr))
-> (a -> WrappedApplicative f (Columns a Expr))
-> a
-> f (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. Expr a -> WrappedApplicative f (Expr a))
-> Columns a Expr -> WrappedApplicative f (Columns a Expr)
forall (t :: HTable) (m :: * -> *) (f :: * -> *) (g :: * -> *).
(HTable t, Apply m) =>
(forall a. f a -> m (g a)) -> t f -> m (t g)
htraverse (f (Expr a) -> WrappedApplicative f (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Expr a) -> WrappedApplicative f (Expr a))
-> (Expr a -> f (Expr a))
-> Expr a
-> WrappedApplicative f (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) (Columns a Expr -> WrappedApplicative f (Columns a Expr))
-> (a -> Columns a Expr)
-> a
-> WrappedApplicative f (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns
{-# INLINABLE unpackspec #-}


valuesspec :: Table Expr a => Opaleye.Valuesspec a a
valuesspec :: Valuesspec a a
valuesspec = PackMap PrimExpr PrimExpr () a -> Unpackspec a a -> Valuesspec a a
forall fields fields'.
PackMap PrimExpr PrimExpr () fields'
-> Unpackspec fields fields' -> Valuesspec fields fields'
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


view :: Selects names exprs => names -> exprs
view :: names -> exprs
view names
columns = Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns exprs Expr -> exprs) -> Columns exprs Expr -> exprs
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns exprs) a -> Expr a)
 -> Columns exprs Expr)
-> (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
    Name String
column -> PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ String -> PrimExpr
Opaleye.BaseTableAttrExpr String
column


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 Expr -> a) -> f (Columns a Expr) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (f (Columns a Expr) -> f a) -> f (Columns a Expr) -> f a
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative f (Columns a Expr) -> f (Columns a Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative f (Columns a Expr) -> f (Columns a Expr))
-> (Columns a Expr -> WrappedApplicative f (Columns a Expr))
-> Columns a Expr
-> f (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. Expr a -> WrappedApplicative f (Expr a))
-> Columns a Expr -> WrappedApplicative f (Columns a Expr)
forall (t :: HTable) (m :: * -> *) (f :: * -> *) (g :: * -> *).
(HTable t, Apply m) =>
(forall a. f a -> m (g a)) -> t f -> m (t g)
htraverse (f (Expr a) -> WrappedApplicative f (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f (Expr a) -> WrappedApplicative f (Expr a))
-> (Expr a -> f (Expr a))
-> Expr a
-> WrappedApplicative f (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) (Columns a Expr -> f (Columns a Expr))
-> Columns a Expr -> f (Columns a Expr)
forall a b. (a -> b) -> a -> b
$
  a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a 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 Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns a Expr -> a) -> Columns a Expr -> a
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate \HField (Columns a) a
field ->
  case Columns a Spec -> HField (Columns a) a -> Spec a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField (Columns a) a
field of
    Spec {TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> case Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field of
        Expr a
expr -> TypeInformation (Unnullify a) -> Expr a -> Expr a
forall a. TypeInformation (Unnullify a) -> Expr a -> Expr a
scastExpr TypeInformation (Unnullify a)
info Expr a
expr