{-# 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
import Data.Functor.Const ( Const( Const ), getConst )
import Data.List.NonEmpty ( NonEmpty )
import Prelude
import qualified Opaleye.Adaptors as Opaleye
import qualified Opaleye.Field as Opaleye ( Field_ )
import qualified Opaleye.Internal.Aggregate as Opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.Values as Opaleye
import qualified Opaleye.Table as Opaleye
import Data.Profunctor ( dimap, lmap )
import Rel8.Aggregate ( Aggregate( Aggregate ), Aggregates )
import Rel8.Expr ( Expr )
import Rel8.Expr.Opaleye
( fromPrimExpr, toPrimExpr
, scastExpr, traverseFieldP
)
import Rel8.Schema.HTable ( htabulateA, hfield, hspecs, htabulate,
htraverseP, htraversePWithField )
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.Type.Information ( typeName )
import Data.Functor.Apply ( WrappedApplicative(..) )
import Data.Profunctor.Product ( ProductProfunctor )
aggregator :: Aggregates aggregates exprs => Opaleye.Aggregator aggregates exprs
aggregator :: forall aggregates exprs.
Aggregates aggregates exprs =>
Aggregator aggregates exprs
aggregator = forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$
forall (t :: HTable) (p :: * -> Context) (f :: Context)
(g :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP forall a b. (a -> b) -> a -> b
$
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(Aggregate Aggregator () (Expr a)
a) -> (Aggregator () (Expr a)
a, ())) forall a b. Aggregator (Aggregator a b, a) b
Opaleye.aggregatorApply
attributes :: Selects names exprs => TableSchema names -> exprs
attributes :: forall names exprs.
Selects names exprs =>
TableSchema names -> exprs
attributes schema :: TableSchema names
schema@TableSchema {names
columns :: forall names. TableSchema names -> names
columns :: names
columns} = forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
Name String
column -> forall a. PrimExpr -> Expr a
fromPrimExpr forall a b. (a -> b) -> a -> b
$ Literal -> PrimExpr
Opaleye.ConstExpr forall a b. (a -> b) -> a -> b
$
String -> Literal
Opaleye.OtherLit forall a b. (a -> b) -> a -> b
$
forall a. Show a => a -> String
show (forall a. TableSchema a -> Doc
ppTable TableSchema names
schema) forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (String -> Doc
ppColumn String
column)
fromOpaleyespec :: (ProductProfunctor p, Table Expr a)
=> p (Opaleye.Field_ n x) (Opaleye.Field_ n x)
-> p a a
fromOpaleyespec :: forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec p (Field_ n x) (Field_ n x)
x =
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (forall (t :: HTable) (p :: * -> Context) (f :: Context)
(g :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP (forall (p :: * -> Context) (n :: Nullability) x (m :: Nullability)
y a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP p (Field_ n x) (Field_ n x)
x))
binaryspec :: Table Expr a => Opaleye.Binaryspec a a
binaryspec :: forall a. Table Expr a => Binaryspec a a
binaryspec = forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec forall (n :: Nullability) a. Binaryspec (Field_ n a) (Field_ n a)
Opaleye.binaryspecField
distinctspec :: Table Expr a => Opaleye.Distinctspec a a
distinctspec :: forall a. Table Expr a => Distinctspec a a
distinctspec = forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec forall (n :: Nullability) a. Distinctspec (Field_ n a) (Field_ n a)
Opaleye.distinctspecField
exprs :: Table Expr a => a -> NonEmpty Opaleye.PrimExpr
exprs :: forall a. Table Expr a => a -> NonEmpty PrimExpr
exprs (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
case forall (t :: HTable) (context :: 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 -> forall {k} a (b :: k). a -> Const a b
Const (forall (f :: Context) a. Applicative f => a -> f a
pure (forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))
exprsWithNames :: Selects names exprs
=> names -> exprs -> NonEmpty (String, Opaleye.PrimExpr)
exprsWithNames :: forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names exprs
as = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
case (forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns names
names) HField (Columns exprs) a
field, forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns exprs
as) HField (Columns exprs) a
field) of
(Name String
name, Expr a
expr) -> forall {k} a (b :: k). a -> Const a b
Const (forall (f :: Context) a. Applicative f => a -> f a
pure (String
name, forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))
table :: Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs
table :: forall names exprs.
Selects names exprs =>
TableSchema names -> Table exprs exprs
table (TableSchema String
name Maybe String
schema names
columns) =
case Maybe String
schema of
Maybe String
Nothing -> forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.table String
name (forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)
Just String
schemaName -> forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.tableWithSchema String
schemaName String
name (forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)
tableFields :: Selects names exprs
=> names -> Opaleye.TableFields exprs exprs
tableFields :: forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns names Name
names) = forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$
forall (f :: Context) a. WrappedApplicative f a -> f a
unwrapApplicative forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (m :: Context) (context :: Context).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field -> forall (f :: Context) a. f a -> WrappedApplicative f a
WrapApplicative forall a b. (a -> b) -> a -> b
$
case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns names Name
names HField (Columns exprs) a
field of
Name a
name -> forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns exprs) a
field) (forall a. Name a -> TableFields (Expr a) (Expr a)
go Name a
name)
where
go :: Name a -> Opaleye.TableFields (Expr a) (Expr a)
go :: forall a. Name a -> TableFields (Expr a) (Expr a)
go (Name String
name) =
forall (p :: * -> Context) (n :: Nullability) x (m :: Nullability)
y a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP forall a b. (a -> b) -> a -> b
$
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 :: forall a. Table Expr a => Unpackspec a a
unpackspec = forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
Opaleye.unpackspecField
{-# INLINABLE unpackspec #-}
valuesspec :: Table Expr a => Opaleye.Valuesspec a a
valuesspec :: forall a. Table Expr a => Valuesspec a a
valuesspec = forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$
forall (t :: HTable) (p :: * -> Context) (f :: Context)
(g :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. HField t a -> p (f a) (g a)) -> p (t f) (t g)
htraversePWithField (forall (p :: * -> Context) (n :: Nullability) x (m :: Nullability)
y a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nullability) a.
String -> Valuesspec (Field_ n a) (Field_ n a)
Opaleye.valuesspecFieldType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. HField (Columns a) a -> String
typeName)
where typeName :: HField (Columns a) a -> String
typeName = forall a. TypeInformation a -> String
Rel8.Type.Information.typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Spec a -> TypeInformation (Unnullify a)
info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs
view :: Selects names exprs => names -> exprs
view :: forall names exprs. Selects names exprs => names -> exprs
view names
columns = forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
Name String
column -> forall a. PrimExpr -> Expr a
fromPrimExpr forall a b. (a -> b) -> a -> b
$ String -> PrimExpr
Opaleye.BaseTableAttrExpr String
column
castTable :: Table Expr a => a -> a
castTable :: forall a. Table Expr a => a -> a
castTable (forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate \HField (Columns a) a
field ->
case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield forall (t :: HTable). HTable t => t Spec
hspecs HField (Columns a) a
field of
Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> case forall (t :: HTable) (context :: 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 -> forall a. TypeInformation (Unnullify a) -> Expr a -> Expr a
scastExpr TypeInformation (Unnullify a)
info Expr a
expr