{-# 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 :: Query a -> Query (ListTable Expr a)
many =
  (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))
 -> ListTable Expr a)
-> Query (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
-> Query (ListTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListTable Expr a
-> (ListTable Expr (Cols Expr (Columns a)) -> ListTable Expr a)
-> MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))
-> ListTable Expr a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable ListTable Expr a
forall a. Monoid a => a
mempty (\(ListTable HListTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) -> HListTable (Columns a) (Context a) -> ListTable Expr a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable HListTable (Columns a) (Context a)
HListTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a)) (Query (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
 -> Query (ListTable Expr a))
-> (Query a
    -> Query
         (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))))
-> Query a
-> Query (ListTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (ListTable Expr (Cols Expr (Columns a)))
-> Query (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
forall a. Query a -> Query (MaybeTable Expr a)
optional (Query (ListTable Expr (Cols Expr (Columns a)))
 -> Query
      (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a)))))
-> (Query a -> Query (ListTable Expr (Cols Expr (Columns a))))
-> Query a
-> Query (MaybeTable Expr (ListTable Expr (Cols Expr (Columns a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (ListTable Aggregate (Cols Aggregate (Columns a)))
-> Query (ListTable Expr (Cols Expr (Columns a)))
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (ListTable Aggregate (Cols Aggregate (Columns a)))
 -> Query (ListTable Expr (Cols Expr (Columns a))))
-> (Query a
    -> Query (ListTable Aggregate (Cols Aggregate (Columns a))))
-> Query a
-> Query (ListTable Expr (Cols Expr (Columns a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> ListTable Aggregate (Cols Aggregate (Columns a)))
-> Query a
-> Query (ListTable Aggregate (Cols Aggregate (Columns a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cols Expr (Columns a)
-> ListTable Aggregate (Cols Aggregate (Columns a))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable Aggregate aggregates
listAgg (Cols Expr (Columns a)
 -> ListTable Aggregate (Cols Aggregate (Columns a)))
-> (a -> Cols Expr (Columns a))
-> a
-> ListTable Aggregate (Cols Aggregate (Columns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cols Expr (Columns a)
forall (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 :: Query a -> Query (NonEmptyTable Expr a)
some =
  (NonEmptyTable Expr (Cols Expr (Columns a))
 -> NonEmptyTable Expr a)
-> Query (NonEmptyTable Expr (Cols Expr (Columns a)))
-> Query (NonEmptyTable Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(NonEmptyTable HNonEmptyTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) -> HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable Expr a
forall (context :: * -> *) a.
HNonEmptyTable (Columns a) (Context a) -> NonEmptyTable context a
NonEmptyTable HNonEmptyTable (Columns a) (Context a)
HNonEmptyTable
  (Columns (Cols Expr (Columns a))) (Context (Cols Expr (Columns a)))
a) (Query (NonEmptyTable Expr (Cols Expr (Columns a)))
 -> Query (NonEmptyTable Expr a))
-> (Query a -> Query (NonEmptyTable Expr (Cols Expr (Columns a))))
-> Query a
-> Query (NonEmptyTable Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> Query (NonEmptyTable Expr (Cols Expr (Columns a)))
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
 -> Query (NonEmptyTable Expr (Cols Expr (Columns a))))
-> (Query a
    -> Query (NonEmptyTable Aggregate (Cols Aggregate (Columns a))))
-> Query a
-> Query (NonEmptyTable Expr (Cols Expr (Columns a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> Query a
-> Query (NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cols Expr (Columns a)
-> NonEmptyTable Aggregate (Cols Aggregate (Columns a))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> NonEmptyTable Aggregate aggregates
nonEmptyAgg (Cols Expr (Columns a)
 -> NonEmptyTable Aggregate (Cols Aggregate (Columns a)))
-> (a -> Cols Expr (Columns a))
-> a
-> NonEmptyTable Aggregate (Cols Aggregate (Columns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cols Expr (Columns a)
forall (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 :: Query (Expr a) -> Query (Expr [a])
manyExpr = (MaybeTable Expr (Expr [a]) -> Expr [a])
-> Query (MaybeTable Expr (Expr [a])) -> Query (Expr [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Expr [a]
-> (Expr [a] -> Expr [a]) -> MaybeTable Expr (Expr [a]) -> Expr [a]
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable Expr [a]
forall a. Monoid a => a
mempty Expr [a] -> Expr [a]
forall a. a -> a
id) (Query (MaybeTable Expr (Expr [a])) -> Query (Expr [a]))
-> (Query (Expr a) -> Query (MaybeTable Expr (Expr [a])))
-> Query (Expr a)
-> Query (Expr [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Expr [a]) -> Query (MaybeTable Expr (Expr [a]))
forall a. Query a -> Query (MaybeTable Expr a)
optional (Query (Expr [a]) -> Query (MaybeTable Expr (Expr [a])))
-> (Query (Expr a) -> Query (Expr [a]))
-> Query (Expr a)
-> Query (MaybeTable Expr (Expr [a]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Aggregate [a]) -> Query (Expr [a])
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (Aggregate [a]) -> Query (Expr [a]))
-> (Query (Expr a) -> Query (Aggregate [a]))
-> Query (Expr a)
-> Query (Expr [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr a -> Aggregate [a])
-> Query (Expr a) -> Query (Aggregate [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> Aggregate [a]
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 :: Query (Expr a) -> Query (Expr (NonEmpty a))
someExpr = Query (Aggregate (NonEmpty a)) -> Query (Expr (NonEmpty a))
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (Aggregate (NonEmpty a)) -> Query (Expr (NonEmpty a)))
-> (Query (Expr a) -> Query (Aggregate (NonEmpty a)))
-> Query (Expr a)
-> Query (Expr (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr a -> Aggregate (NonEmpty a))
-> Query (Expr a) -> Query (Aggregate (NonEmpty a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> Aggregate (NonEmpty a)
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 :: ListTable Expr a -> Query a
catListTable (ListTable HListTable (Columns a) (Context a)
as) =
  String -> a -> Query a
forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" (a -> Query a) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ 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
$ 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 :: * -> *) (list :: * -> *)
       (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} -> Expr a -> Identity (Expr a)
forall (f :: * -> *) 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
. TypeInformation (Unnullify a) -> Expr [a] -> Expr a
forall a (list :: * -> *).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info) HVectorize [] (Columns a) Expr
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 :: NonEmptyTable Expr a -> Query a
catNonEmptyTable (NonEmptyTable HNonEmptyTable (Columns a) (Context a)
as) =
  String -> a -> Query a
forall a. Table Expr a => String -> a -> Query a
rebind String
"unnest" (a -> Query a) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ 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
$ 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 :: * -> *) (list :: * -> *)
       (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} -> Expr a -> Identity (Expr a)
forall (f :: * -> *) 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
. TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a
forall a (list :: * -> *).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info) HVectorize NonEmpty (Columns a) Expr
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 :: 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
. TypeInformation (Unnullify a) -> Expr [a] -> Expr a
forall a (list :: * -> *).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
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 :: 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
. TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a
forall a (list :: * -> *).
TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
forall a. DBType a => TypeInformation a
typeInformation


sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
sunnest TypeInformation (Unnullify a)
info = (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
$
  TypeInformation (Unnullify a) -> PrimExpr -> PrimExpr
forall a. TypeInformation a -> PrimExpr -> PrimExpr
extractArrayElement TypeInformation (Unnullify a)
info (PrimExpr -> PrimExpr)
-> (PrimExpr -> PrimExpr) -> PrimExpr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr (String -> UnOp
Opaleye.UnOpOther String
"UNNEST")