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

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

-- base
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 )
import Rel8.Query.Maybe ( optional )
import Rel8.Query.Rebind ( rebind )
import Rel8.Schema.HTable.Vectorize ( hunvectorize )
import Rel8.Schema.Null ( Sql, Unnullify )
import Rel8.Schema.Spec ( Spec( Spec, info ) )
import Rel8.Table ( Table, fromColumns )
import Rel8.Table.Cols ( toCols )
import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )
import Rel8.Table.List ( ListTable( ListTable ) )
import Rel8.Table.Maybe ( maybeTable )
import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
import Rel8.Type ( DBType, typeInformation )
import Rel8.Type.Array ( extractArrayElement )
import Rel8.Type.Information ( TypeInformation )


-- | 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 =
  forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable forall a. Monoid a => a
mempty (\(ListTable HListTable
  (Columns (Transpose Expr (Cols Aggregate (Columns a))))
  (Context (Transpose Expr (Cols Aggregate (Columns a))))
a) -> forall (context :: Context) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable HListTable
  (Columns (Transpose Expr (Cols Aggregate (Columns a))))
  (Context (Transpose Expr (Cols Aggregate (Columns a))))
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. Query a -> Query (MaybeTable Expr a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable Aggregate aggregates
listAgg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: Context) a.
Table context a =>
a -> Cols context (Columns a)
toCols)


-- | 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 =
  forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NonEmptyTable HNonEmptyTable
  (Columns (Transpose Expr (Cols Aggregate (Columns a))))
  (Context (Transpose Expr (Cols Aggregate (Columns a))))
a) -> forall (context :: Context) a.
HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable context a
NonEmptyTable HNonEmptyTable
  (Columns (Transpose Expr (Cols Aggregate (Columns a))))
  (Context (Transpose Expr (Cols Aggregate (Columns a))))
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable Aggregate aggregates
nonEmptyAgg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (context :: Context) a.
Table context a =>
a -> Cols context (Columns a)
toCols)


-- | 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 = forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable forall a. Monoid a => a
mempty forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Query a -> Query (MaybeTable Expr a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sql DBType a => Expr a -> Aggregate [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 = forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sql DBType a => Expr a -> Aggregate (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) =
  forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" forall a b. (a -> b) -> a -> b
$ forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
    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 {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> forall (f :: Context) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (list :: Context).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info) HListTable (Columns a) (Context a)
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) =
  forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" forall a b. (a -> b) -> a -> b
$ forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
    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 {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> forall (f :: Context) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (list :: Context).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info) HNonEmptyTable (Columns a) (Context a)
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 = forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (list :: Context).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest forall a. DBType a => TypeInformation a
typeInformation


-- | 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 = forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (list :: Context).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest forall a. DBType a => TypeInformation a
typeInformation


sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest :: forall a (list :: Context).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info = forall a b. (PrimExpr -> PrimExpr) -> Expr a -> Expr b
mapPrimExpr forall a b. (a -> b) -> a -> b
$
  forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation (Unnullify a)
info forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (String -> UnOp
Opaleye.UnOpOther String
"UNNEST")