{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language NamedFieldPuns #-}
module Rel8.Query.List
( many, some
, manyExpr, someExpr
, catListTable, catNonEmptyTable
, catList, catNonEmpty
)
where
import Control.Monad ((>=>))
import Data.Functor.Identity ( runIdentity )
import Data.List.NonEmpty ( NonEmpty )
import Prelude
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
import Rel8.Expr.Opaleye ( mapPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Aggregate (aggregate, aggregate1)
import Rel8.Query.Rebind (hrebind, rebind)
import Rel8.Schema.HTable (HTable, hfield, hspecs, htabulate)
import Rel8.Schema.HTable.Vectorize ( hunvectorize )
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Spec ( Spec( Spec, info ) )
import Rel8.Table (Table, fromColumns, toColumns)
import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )
import Rel8.Table.List ( ListTable( ListTable ) )
import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
import Rel8.Type ( DBType )
import Rel8.Type.Array ( extractArrayElement )
many :: Table Expr a => Query a -> Query (ListTable Expr a)
many :: forall a. Table Expr a => Query a -> Query (ListTable Expr a)
many = Aggregator a (ListTable Expr a)
-> Query a -> Query (ListTable Expr a)
forall i a.
(Table Expr i, Table Expr a) =>
Aggregator i a -> Query i -> Query a
aggregate Aggregator a (ListTable Expr a)
forall a (fold :: Fold).
Table Expr a =>
Aggregator' fold a (ListTable Expr a)
listAgg
some :: Table Expr a => Query a -> Query (NonEmptyTable Expr a)
some :: forall a. Table Expr a => Query a -> Query (NonEmptyTable Expr a)
some = Aggregator' 'Semi a (NonEmptyTable Expr a)
-> Query a -> Query (NonEmptyTable Expr a)
forall i (fold :: Fold) a.
Table Expr i =>
Aggregator' fold i a -> Query i -> Query a
aggregate1 Aggregator' 'Semi a (NonEmptyTable Expr a)
forall a. Table Expr a => Aggregator1 a (NonEmptyTable Expr a)
nonEmptyAgg
manyExpr :: Sql DBType a => Query (Expr a) -> Query (Expr [a])
manyExpr :: forall a. Sql DBType a => Query (Expr a) -> Query (Expr [a])
manyExpr = Aggregator (Expr a) (Expr [a])
-> Query (Expr a) -> Query (Expr [a])
forall i a.
(Table Expr i, Table Expr a) =>
Aggregator i a -> Query i -> Query a
aggregate Aggregator (Expr a) (Expr [a])
forall a (fold :: Fold).
Sql DBType a =>
Aggregator' fold (Expr a) (Expr [a])
listAggExpr
someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))
someExpr :: forall a.
Sql DBType a =>
Query (Expr a) -> Query (Expr (NonEmpty a))
someExpr = Aggregator' 'Semi (Expr a) (Expr (NonEmpty a))
-> Query (Expr a) -> Query (Expr (NonEmpty a))
forall i (fold :: Fold) a.
Table Expr i =>
Aggregator' fold i a -> Query i -> Query a
aggregate1 Aggregator' 'Semi (Expr a) (Expr (NonEmpty a))
forall a. Sql DBType a => Aggregator1 (Expr a) (Expr (NonEmpty a))
nonEmptyAggExpr
catListTable :: Table Expr a => ListTable Expr a -> Query a
catListTable :: forall a. Table Expr a => ListTable Expr a -> Query a
catListTable (ListTable HListTable (Columns a) (Context a)
as) =
(Columns a Expr -> a) -> Query (Columns a Expr) -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Query (Columns a Expr) -> Query a)
-> Query (Columns a Expr) -> Query a
forall a b. (a -> b) -> a -> b
$ (String -> Columns a Expr -> Query (Columns a Expr)
forall (t :: HTable).
HTable t =>
String -> t Expr -> Query (t Expr)
hrebind String
"unnest" (Columns a Expr -> Query (Columns a Expr))
-> (Columns a Expr -> Query (Columns a Expr))
-> Columns a Expr
-> Query (Columns a Expr)
forall (m :: Context) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Columns a Expr -> Query (Columns a Expr)
forall (t :: HTable). HTable t => t Expr -> Query (t Expr)
hextract) (Columns a Expr -> Query (Columns a Expr))
-> Columns a Expr -> Query (Columns a Expr)
forall a b. (a -> b) -> a -> b
$ Identity (Columns a Expr) -> Columns a Expr
forall a. Identity a -> a
runIdentity (Identity (Columns a Expr) -> Columns a Expr)
-> Identity (Columns a Expr) -> Columns a Expr
forall a b. (a -> b) -> a -> b
$
(forall a. Spec a -> Expr [a] -> Identity (Expr a))
-> HVectorize [] (Columns a) Expr -> Identity (Columns a Expr)
forall (t :: HTable) (f :: Context) (list :: Context)
(context :: Context) (context' :: Context).
(HTable t, Zip f, Vector list) =>
(forall a. Spec a -> context (list a) -> f (context' a))
-> HVectorize list t context -> f (t context')
hunvectorize (\Spec a
_ -> Expr a -> Identity (Expr a)
forall a. a -> Identity a
forall (f :: Context) a. Applicative f => a -> f a
pure (Expr a -> Identity (Expr a))
-> (Expr [a] -> Expr a) -> Expr [a] -> Identity (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr [a] -> Expr a
forall (list :: Context) a. Expr (list a) -> Expr a
unnest) HListTable (Columns a) (Context a)
HVectorize [] (Columns a) Expr
as
catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a
catNonEmptyTable :: forall a. Table Expr a => NonEmptyTable Expr a -> Query a
catNonEmptyTable (NonEmptyTable HNonEmptyTable (Columns a) (Context a)
as) =
(Columns a Expr -> a) -> Query (Columns a Expr) -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Query (Columns a Expr) -> Query a)
-> Query (Columns a Expr) -> Query a
forall a b. (a -> b) -> a -> b
$ (String -> Columns a Expr -> Query (Columns a Expr)
forall (t :: HTable).
HTable t =>
String -> t Expr -> Query (t Expr)
hrebind String
"unnest" (Columns a Expr -> Query (Columns a Expr))
-> (Columns a Expr -> Query (Columns a Expr))
-> Columns a Expr
-> Query (Columns a Expr)
forall (m :: Context) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Columns a Expr -> Query (Columns a Expr)
forall (t :: HTable). HTable t => t Expr -> Query (t Expr)
hextract) (Columns a Expr -> Query (Columns a Expr))
-> Columns a Expr -> Query (Columns a Expr)
forall a b. (a -> b) -> a -> b
$ Identity (Columns a Expr) -> Columns a Expr
forall a. Identity a -> a
runIdentity (Identity (Columns a Expr) -> Columns a Expr)
-> Identity (Columns a Expr) -> Columns a Expr
forall a b. (a -> b) -> a -> b
$
(forall a. Spec a -> Expr (NonEmpty a) -> Identity (Expr a))
-> HVectorize NonEmpty (Columns a) Expr
-> Identity (Columns a Expr)
forall (t :: HTable) (f :: Context) (list :: Context)
(context :: Context) (context' :: Context).
(HTable t, Zip f, Vector list) =>
(forall a. Spec a -> context (list a) -> f (context' a))
-> HVectorize list t context -> f (t context')
hunvectorize (\Spec a
_ -> Expr a -> Identity (Expr a)
forall a. a -> Identity a
forall (f :: Context) a. Applicative f => a -> f a
pure (Expr a -> Identity (Expr a))
-> (Expr (NonEmpty a) -> Expr a)
-> Expr (NonEmpty a)
-> Identity (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr (NonEmpty a) -> Expr a
forall (list :: Context) a. Expr (list a) -> Expr a
unnest) HNonEmptyTable (Columns a) (Context a)
HVectorize NonEmpty (Columns a) Expr
as
catList :: Sql DBType a => Expr [a] -> Query (Expr a)
catList :: forall a. Sql DBType a => Expr [a] -> Query (Expr a)
catList = String -> Expr a -> Query (Expr a)
forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" (Expr a -> Query (Expr a))
-> (Expr [a] -> Expr a) -> Expr [a] -> Query (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr [a] -> Expr a
forall (list :: Context) a. Expr (list a) -> Expr a
unnest (Expr [a] -> Query (Expr a))
-> (Expr a -> Query (Expr a)) -> Expr [a] -> Query (Expr a)
forall (m :: Context) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Expr a -> Query (Expr a)
forall a. Table Expr a => a -> Query a
extract
catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
catNonEmpty :: forall a. Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
catNonEmpty = String -> Expr a -> Query (Expr a)
forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" (Expr a -> Query (Expr a))
-> (Expr (NonEmpty a) -> Expr a)
-> Expr (NonEmpty a)
-> Query (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr (NonEmpty a) -> Expr a
forall (list :: Context) a. Expr (list a) -> Expr a
unnest (Expr (NonEmpty a) -> Query (Expr a))
-> (Expr a -> Query (Expr a))
-> Expr (NonEmpty a)
-> Query (Expr a)
forall (m :: Context) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Expr a -> Query (Expr a)
forall a. Table Expr a => a -> Query a
extract
unnest :: Expr (list a) -> Expr a
unnest :: forall (list :: Context) a. Expr (list a) -> Expr a
unnest = (PrimExpr -> PrimExpr) -> Expr (list a) -> Expr a
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr ((PrimExpr -> PrimExpr) -> Expr (list a) -> Expr a)
-> (PrimExpr -> PrimExpr) -> Expr (list a) -> Expr a
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (String -> UnOp
Opaleye.UnOpOther String
"UNNEST")
extract :: Table Expr a => a -> Query a
= (Columns a Expr -> a) -> Query (Columns a Expr) -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Query (Columns a Expr) -> Query a)
-> (a -> Query (Columns a Expr)) -> a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns a Expr -> Query (Columns a Expr)
forall (t :: HTable). HTable t => t Expr -> Query (t Expr)
hextract (Columns a Expr -> Query (Columns a Expr))
-> (a -> Columns a Expr) -> a -> Query (Columns a Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns
hextract :: HTable t => t Expr -> Query (t Expr)
= String -> t Expr -> Query (t Expr)
forall (t :: HTable).
HTable t =>
String -> t Expr -> Query (t Expr)
hrebind String
"extract" (t Expr -> Query (t Expr))
-> (t Expr -> t Expr) -> t Expr -> Query (t Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Expr -> t Expr
forall {t :: HTable}. HTable t => t Expr -> t Expr
go
where
go :: t Expr -> t Expr
go t Expr
as = (forall a. HField t a -> Expr a) -> t Expr
forall (context :: Context).
(forall a. HField t a -> context a) -> t context
forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField t a -> Expr a) -> t Expr)
-> (forall a. HField t a -> Expr a) -> t Expr
forall a b. (a -> b) -> a -> b
$ \HField t a
field ->
case t Expr -> HField t a -> Expr a
forall (context :: Context) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield t Expr
as HField t a
field of
Expr a
a -> case t Spec -> HField t a -> Spec a
forall (context :: Context) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
Spec {TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> (PrimExpr -> PrimExpr) -> Expr a -> Expr a
forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr (TypeInformation (Unnullify a) -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation (Unnullify a)
info) Expr a
a