{-# language FlexibleContexts #-}
{-# language GADTs #-}
{-# language NamedFieldPuns #-}

module Rel8.Query.List
  ( many, some
  , manyExpr, someExpr
  , catListTable, catNonEmptyTable
  , catList, catNonEmpty
  )
where

-- base
import Control.Monad ((>=>))
import Data.Functor.Identity ( runIdentity )
import Data.List.NonEmpty ( NonEmpty )
import Prelude

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

-- rel8
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 )


-- | Aggregate a 'Query' into a 'ListTable'. If the supplied query returns 0
-- rows, this function will produce a 'Query' that returns one row containing
-- the empty @ListTable@. If the supplied @Query@ does return rows, @many@ will
-- return exactly one row, with a @ListTable@ collecting all returned rows.
--
-- @many@ is analogous to 'Control.Applicative.many' from
-- @Control.Applicative@.
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


-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns
-- 0 rows, this function will produce a 'Query' that is empty - that is, will
-- produce zero @NonEmptyTable@s. If the supplied @Query@ does return rows,
-- @some@ will return exactly one row, with a @NonEmptyTable@ collecting all
-- returned rows.
--
-- @some@ is analogous to 'Control.Applicative.some' from
-- @Control.Applicative@.
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


-- | A version of 'many' specialised to single expressions.
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


-- | A version of 'many' specialised to single expressions.
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


-- | Expand a 'ListTable' into a 'Query', where each row in the query is an
-- element of the given @ListTable@.
--
-- @catListTable@ is an inverse to 'many'.
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


-- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an
-- element of the given @NonEmptyTable@.
--
-- @catNonEmptyTable@ is an inverse to 'some'.
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


-- | Expand an expression that contains a list into a 'Query', where each row
-- in the query is an element of the given list.
--
-- @catList@ is an inverse to 'manyExpr'.
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


-- | Expand an expression that contains a non-empty list into a 'Query', where
-- each row in the query is an element of the given list.
--
-- @catNonEmpty@ is an inverse to 'someExpr'.
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
extract :: forall a. Table Expr a => a -> Query a
extract = (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)
hextract :: forall (t :: HTable). HTable t => t Expr -> Query (t Expr)
hextract = 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