{-# 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 ( Col( E, unE ), 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.Schema.HTable.Vectorize ( hunvectorize )
import Rel8.Schema.Null ( Sql, Unnullify )
import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
import Rel8.Table ( Table, fromColumns, toColumns )
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 a)
many :: Query a -> Query (ListTable a)
many =
  (MaybeTable (ListTable (Columns a (Col Expr))) -> ListTable a)
-> Query (MaybeTable (ListTable (Columns a (Col Expr))))
-> Query (ListTable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListTable a
-> (ListTable (Columns a (Col Expr)) -> ListTable a)
-> MaybeTable (ListTable (Columns a (Col Expr)))
-> ListTable a
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable a -> b
maybeTable ListTable a
forall a. Monoid a => a
mempty (\(ListTable HListTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a) -> HListTable (Columns a) (Col (Context a)) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable HListTable (Columns a) (Col (Context a))
HListTable
  (Columns (Columns a (Col Expr)))
  (Col (Context (Columns a (Col Expr))))
a)) (Query (MaybeTable (ListTable (Columns a (Col Expr))))
 -> Query (ListTable a))
-> (Query a
    -> Query (MaybeTable (ListTable (Columns a (Col Expr)))))
-> Query a
-> Query (ListTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (ListTable (Columns a (Col Expr)))
-> Query (MaybeTable (ListTable (Columns a (Col Expr))))
forall a. Query a -> Query (MaybeTable a)
optional (Query (ListTable (Columns a (Col Expr)))
 -> Query (MaybeTable (ListTable (Columns a (Col Expr)))))
-> (Query a -> Query (ListTable (Columns a (Col Expr))))
-> Query a
-> Query (MaybeTable (ListTable (Columns a (Col Expr))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Query (ListTable (Columns a (Col Aggregate)))
-> Query (ListTable (Columns a (Col Expr)))
forall aggregates exprs.
Aggregates aggregates exprs =>
Query aggregates -> Query exprs
aggregate (Query (ListTable (Columns a (Col Aggregate)))
 -> Query (ListTable (Columns a (Col Expr))))
-> (Query a -> Query (ListTable (Columns a (Col Aggregate))))
-> Query a
-> Query (ListTable (Columns a (Col Expr)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> ListTable (Columns a (Col Aggregate)))
-> Query a -> Query (ListTable (Columns a (Col Aggregate)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Columns a (Col Expr) -> ListTable (Columns a (Col Aggregate))
forall aggregates exprs.
Aggregates aggregates exprs =>
exprs -> ListTable aggregates
listAgg (Columns a (Col Expr) -> ListTable (Columns a (Col Aggregate)))
-> (a -> Columns a (Col Expr))
-> a
-> ListTable (Columns a (Col Aggregate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns)


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


-- | 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 [a]) -> Expr [a])
-> Query (MaybeTable (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 [a]) -> Expr [a]
forall b a. Table Expr b => b -> (a -> b) -> MaybeTable a -> b
maybeTable Expr [a]
forall a. Monoid a => a
mempty Expr [a] -> Expr [a]
forall a. a -> a
id) (Query (MaybeTable (Expr [a])) -> Query (Expr [a]))
-> (Query (Expr a) -> Query (MaybeTable (Expr [a])))
-> Query (Expr a)
-> Query (Expr [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query (Expr [a]) -> Query (MaybeTable (Expr [a]))
forall a. Query a -> Query (MaybeTable a)
optional (Query (Expr [a]) -> Query (MaybeTable (Expr [a])))
-> (Query (Expr a) -> Query (Expr [a]))
-> Query (Expr a)
-> Query (MaybeTable (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


catListTable :: Table Expr a => ListTable a -> Query a
catListTable :: ListTable a -> Query a
catListTable (ListTable HListTable (Columns a) (Col (Context a))
as) = a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Query a) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns a (Col Expr) -> a) -> Columns a (Col Expr) -> a
forall a b. (a -> b) -> a -> b
$ Identity (Columns a (Col Expr)) -> Columns a (Col Expr)
forall a. Identity a -> a
runIdentity (Identity (Columns a (Col Expr)) -> Columns a (Col Expr))
-> Identity (Columns a (Col Expr)) -> Columns a (Col Expr)
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Col Expr ('Spec labels 'Required [a])
 -> Identity (Col Expr ('Spec labels necessity a)))
-> HVectorize [] (Columns a) (Col Expr)
-> Identity (Columns a (Col Expr))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: HContext) (context' :: HContext).
(HTable t, Zip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> context ('Spec labels 'Required (list a))
 -> f (context' ('Spec labels necessity a)))
-> HVectorize list t context -> f (t context')
hunvectorize (\SSpec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> TypeInformation (Unnullify a)
info} -> Col Expr ('Spec labels necessity a)
-> Identity (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col Expr ('Spec labels necessity a)
 -> Identity (Col Expr ('Spec labels necessity a)))
-> (Col Expr ('Spec labels 'Required [a])
    -> Col Expr ('Spec labels necessity a))
-> Col Expr ('Spec labels 'Required [a])
-> Identity (Col Expr ('Spec labels necessity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> (Col Expr ('Spec labels 'Required [a]) -> Expr a)
-> Col Expr ('Spec labels 'Required [a])
-> Col Expr ('Spec labels necessity 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)
TypeInformation (Unnullify a)
info (Expr [a] -> Expr a)
-> (Col Expr ('Spec labels 'Required [a]) -> Expr [a])
-> Col Expr ('Spec labels 'Required [a])
-> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Col Expr ('Spec labels 'Required [a]) -> Expr [a]
forall (labels :: Labels) (necessity :: Necessity) a.
Col Expr ('Spec labels necessity a) -> Expr a
unE) HVectorize [] (Columns a) (Col Expr)
HListTable (Columns a) (Col (Context a))
as


catNonEmptyTable :: Table Expr a => NonEmptyTable a -> Query a
catNonEmptyTable :: NonEmptyTable a -> Query a
catNonEmptyTable (NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
as) = a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Query a) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ Columns a (Col Expr) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns (Columns a (Col Expr) -> a) -> Columns a (Col Expr) -> a
forall a b. (a -> b) -> a -> b
$ Identity (Columns a (Col Expr)) -> Columns a (Col Expr)
forall a. Identity a -> a
runIdentity (Identity (Columns a (Col Expr)) -> Columns a (Col Expr))
-> Identity (Columns a (Col Expr)) -> Columns a (Col Expr)
forall a b. (a -> b) -> a -> b
$
  (forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Col Expr ('Spec labels 'Required (NonEmpty a))
 -> Identity (Col Expr ('Spec labels necessity a)))
-> HVectorize NonEmpty (Columns a) (Col Expr)
-> Identity (Columns a (Col Expr))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: HContext) (context' :: HContext).
(HTable t, Zip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> context ('Spec labels 'Required (list a))
 -> f (context' ('Spec labels necessity a)))
-> HVectorize list t context -> f (t context')
hunvectorize (\SSpec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> TypeInformation (Unnullify a)
info} -> Col Expr ('Spec labels necessity a)
-> Identity (Col Expr ('Spec labels necessity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col Expr ('Spec labels necessity a)
 -> Identity (Col Expr ('Spec labels necessity a)))
-> (Col Expr ('Spec labels 'Required (NonEmpty a))
    -> Col Expr ('Spec labels necessity a))
-> Col Expr ('Spec labels 'Required (NonEmpty a))
-> Identity (Col Expr ('Spec labels necessity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> Col Expr ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr a -> Col Expr ('Spec labels necessity a))
-> (Col Expr ('Spec labels 'Required (NonEmpty a)) -> Expr a)
-> Col Expr ('Spec labels 'Required (NonEmpty a))
-> Col Expr ('Spec labels necessity 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)
TypeInformation (Unnullify a)
info (Expr (NonEmpty a) -> Expr a)
-> (Col Expr ('Spec labels 'Required (NonEmpty a))
    -> Expr (NonEmpty a))
-> Col Expr ('Spec labels 'Required (NonEmpty a))
-> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Col Expr ('Spec labels 'Required (NonEmpty a)) -> Expr (NonEmpty a)
forall (labels :: Labels) (necessity :: Necessity) a.
Col Expr ('Spec labels necessity a) -> Expr a
unE) HVectorize NonEmpty (Columns a) (Col Expr)
HNonEmptyTable (Columns a) (Col (Context a))
as


catList :: Sql DBType a => Expr [a] -> Query (Expr a)
catList :: Expr [a] -> Query (Expr a)
catList = Expr a -> Query (Expr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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


catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
catNonEmpty :: Expr (NonEmpty a) -> Query (Expr a)
catNonEmpty = Expr a -> Query (Expr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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")