{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Table.List
  ( ListTable(..)
  , ($*)
  , listTable
  , nameListTable
  )
where

-- base
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Prelude

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Array ( sappend, sempty, slistOf )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable.List ( HListTable )
import Rel8.Schema.HTable.Vectorize
  ( hvectorize, hunvectorize
  , happend, hempty
  , hproject, hcolumn
  )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Name ( Name( Name ) )
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import Rel8.Schema.Result ( vectorizer, unvectorizer )
import Rel8.Schema.Spec ( Spec(..) )
import Rel8.Table
  ( Table, Context, Columns, fromColumns, toColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Table.Alternative
  ( AltTable, (<|>:)
  , AlternativeTable, emptyTable
  )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Projection
  ( Projectable, Projecting, Projection, project, apply
  )
import Rel8.Table.Serialize ( ToExprs )


-- | A @ListTable@ value contains zero or more instances of @a@. You construct
-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
type ListTable :: K.Context -> Type -> Type
newtype ListTable context a =
  ListTable (HListTable (Columns a) (Context a))


instance Projectable (ListTable context) where
  project :: Projection a b -> ListTable context a -> ListTable context b
project Projection a b
f (ListTable HListTable (Columns a) (Context a)
a) = HListTable (Columns b) (Context b) -> ListTable context b
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable ((forall (ctx :: * -> *).
 Columns (Transpose (Field a) a) ctx
 -> Columns (Transpose (Field a) b) ctx)
-> HVectorize [] (Columns (Transpose (Field a) a)) (Context b)
-> HVectorize [] (Columns (Transpose (Field a) b)) (Context b)
forall (t :: HTable) (t' :: HTable) (list :: * -> *)
       (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HVectorize list t context -> HVectorize list t' context
hproject (Projection a b -> Columns a ctx -> Columns b ctx
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f) HListTable (Columns a) (Context a)
HVectorize [] (Columns (Transpose (Field a) a)) (Context b)
a)


instance (Table context a, context ~ context') =>
  Table context' (ListTable context a)
 where
  type Columns (ListTable context a) = HListTable (Columns a)
  type Context (ListTable context a) = Context a
  type FromExprs (ListTable context a) = [FromExprs a]
  type Transpose to (ListTable context a) = ListTable to (Transpose to a)

  fromColumns :: Columns (ListTable context a) context' -> ListTable context a
fromColumns = Columns (ListTable context a) context' -> ListTable context a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable
  toColumns :: ListTable context a -> Columns (ListTable context a) context'
toColumns (ListTable HListTable (Columns a) (Context a)
a) = Columns (ListTable context a) context'
HListTable (Columns a) (Context a)
a
  fromResult :: Columns (ListTable context a) Result
-> FromExprs (ListTable context a)
fromResult = (Columns a Result -> FromExprs a)
-> [Columns a Result] -> [FromExprs a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Table context' a => Columns a Result -> FromExprs a
forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @a) ([Columns a Result] -> [FromExprs a])
-> (HVectorize [] (Columns a) Result -> [Columns a Result])
-> HVectorize [] (Columns a) Result
-> [FromExprs a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Spec a -> Result [a] -> [Result a])
-> HVectorize [] (Columns a) Result -> [Columns a Result]
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 forall a. Spec a -> Result [a] -> [Result a]
forall (f :: * -> *) a.
Functor f =>
Spec a -> Result (f a) -> f (Result a)
unvectorizer
  toResult :: FromExprs (ListTable context a)
-> Columns (ListTable context a) Result
toResult = (forall a. Spec a -> [Result a] -> Result [a])
-> [Columns a Result] -> HVectorize [] (Columns a) Result
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize forall a. Spec a -> [Result a] -> Result [a]
forall (f :: * -> *) a.
Functor f =>
Spec a -> f (Result a) -> Result (f a)
vectorizer ([Columns a Result] -> HVectorize [] (Columns a) Result)
-> ([FromExprs a] -> [Columns a Result])
-> [FromExprs a]
-> HVectorize [] (Columns a) Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FromExprs a -> Columns a Result)
-> [FromExprs a] -> [Columns a Result]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Table context' a => FromExprs a -> Columns a Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @a)


instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
  eqTable :: Columns (ListTable context a) (Dict (Sql DBEq))
eqTable =
    (forall a.
 Spec a -> Identity (Dict (Sql DBEq) a) -> Dict (Sql DBEq) [a])
-> Identity (Columns a (Dict (Sql DBEq)))
-> HVectorize [] (Columns a) (Dict (Sql DBEq))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize
      (\Spec {Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity :: Nullity a
nullity} (Identity Dict) -> case Nullity a
nullity of
        Nullity a
Null -> Dict (Sql DBEq) [a]
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
        Nullity a
NotNull -> Dict (Sql DBEq) [a]
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
      (Columns a (Dict (Sql DBEq))
-> Identity (Columns a (Dict (Sql DBEq)))
forall a. a -> Identity a
Identity (EqTable a => Columns a (Dict (Sql DBEq))
forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @a))


instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
  ordTable :: Columns (ListTable context a) (Dict (Sql DBOrd))
ordTable =
    (forall a.
 Spec a -> Identity (Dict (Sql DBOrd) a) -> Dict (Sql DBOrd) [a])
-> Identity (Columns a (Dict (Sql DBOrd)))
-> HVectorize [] (Columns a) (Dict (Sql DBOrd))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize
      (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} (Identity Dict) -> case Nullity a
nullity of
        Nullity a
Null -> Dict (Sql DBOrd) [a]
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
        Nullity a
NotNull -> Dict (Sql DBOrd) [a]
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
      (Columns a (Dict (Sql DBOrd))
-> Identity (Columns a (Dict (Sql DBOrd)))
forall a. a -> Identity a
Identity (OrdTable a => Columns a (Dict (Sql DBOrd))
forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @a))


instance (ToExprs exprs a, context ~ Expr) =>
  ToExprs (ListTable context exprs) [a]


instance context ~ Expr => AltTable (ListTable context) where
  <|>: :: ListTable context a -> ListTable context a -> ListTable context a
(<|>:) = ListTable context a -> ListTable context a -> ListTable context a
forall a. Semigroup a => a -> a -> a
(<>)


instance context ~ Expr => AlternativeTable (ListTable context) where
  emptyTable :: ListTable context a
emptyTable = ListTable context a
forall a. Monoid a => a
mempty


instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a)
 where
  ListTable HListTable (Columns a) (Context a)
as <> :: ListTable context a -> ListTable context a -> ListTable context a
<> ListTable HListTable (Columns a) (Context a)
bs = HListTable (Columns a) (Context a) -> ListTable context a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable (HListTable (Columns a) (Context a) -> ListTable context a)
-> HListTable (Columns a) (Context a) -> ListTable context a
forall a b. (a -> b) -> a -> b
$ (forall a. Spec a -> Expr [a] -> Expr [a] -> Expr [a])
-> HVectorize [] (Columns a) Expr
-> HVectorize [] (Columns a) Expr
-> HVectorize [] (Columns a) Expr
forall (t :: HTable) (list :: * -> *) (context :: * -> *).
(HTable t, Vector list) =>
(forall a.
 Spec a -> context (list a) -> context (list a) -> context (list a))
-> HVectorize list t context
-> HVectorize list t context
-> HVectorize list t context
happend ((Expr [a] -> Expr [a] -> Expr [a])
-> Spec a -> Expr [a] -> Expr [a] -> Expr [a]
forall a b. a -> b -> a
const Expr [a] -> Expr [a] -> Expr [a]
forall a. Expr [a] -> Expr [a] -> Expr [a]
sappend) HVectorize [] (Columns a) Expr
HListTable (Columns a) (Context a)
as HVectorize [] (Columns a) Expr
HListTable (Columns a) (Context a)
bs


instance (context ~ Expr, Table Expr a) =>
  Monoid (ListTable context a)
 where
  mempty :: ListTable context a
mempty = HListTable (Columns a) (Context a) -> ListTable context a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable (HListTable (Columns a) (Context a) -> ListTable context a)
-> HListTable (Columns a) (Context a) -> ListTable context a
forall a b. (a -> b) -> a -> b
$ (forall a. Spec a -> Expr [a]) -> HVectorize [] (Columns a) Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context [a]) -> HVectorize [] t context
hempty ((forall a. Spec a -> Expr [a]) -> HVectorize [] (Columns a) Expr)
-> (forall a. Spec a -> Expr [a]) -> HVectorize [] (Columns a) Expr
forall a b. (a -> b) -> a -> b
$ \Spec {TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> TypeInformation (Unnullify a) -> Expr [a]
forall a. TypeInformation (Unnullify a) -> Expr [a]
sempty TypeInformation (Unnullify a)
info


-- | Project a single expression out of a 'ListTable'.
($*) :: Projecting a (Expr b)
  => Projection a (Expr b) -> ListTable Expr a -> Expr [b]
Projection a (Expr b)
f $* :: Projection a (Expr b) -> ListTable Expr a -> Expr [b]
$* ListTable HListTable (Columns a) (Context a)
a = HVectorize [] (HIdentity b) Expr -> Expr [b]
forall (list :: * -> *) a (context :: * -> *).
HVectorize list (HIdentity a) context -> context (list a)
hcolumn (HVectorize [] (HIdentity b) Expr -> Expr [b])
-> HVectorize [] (HIdentity b) Expr -> Expr [b]
forall a b. (a -> b) -> a -> b
$ (forall (ctx :: * -> *).
 Columns (Transpose (Field a) a) ctx -> HIdentity b ctx)
-> HVectorize [] (Columns (Transpose (Field a) a)) Expr
-> HVectorize [] (HIdentity b) Expr
forall (t :: HTable) (t' :: HTable) (list :: * -> *)
       (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HVectorize list t context -> HVectorize list t' context
hproject (Projection a (Expr b) -> Columns a ctx -> Columns (Expr b) ctx
forall a b (context :: * -> *).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a (Expr b)
f) HListTable (Columns a) (Context a)
HVectorize [] (Columns (Transpose (Field a) a)) Expr
a
infixl 4 $*


-- | Construct a @ListTable@ from a list of expressions.
listTable :: Table Expr a => [a] -> ListTable Expr a
listTable :: [a] -> ListTable Expr a
listTable =
  HVectorize [] (Columns a) Expr -> ListTable Expr a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable (HVectorize [] (Columns a) Expr -> ListTable Expr a)
-> ([a] -> HVectorize [] (Columns a) Expr)
-> [a]
-> ListTable Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. Spec a -> [Expr a] -> Expr [a])
-> [Columns a Expr] -> HVectorize [] (Columns a) Expr
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize (\Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
forall a. TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
slistOf TypeInformation (Unnullify a)
info) ([Columns a Expr] -> HVectorize [] (Columns a) Expr)
-> ([a] -> [Columns a Expr])
-> [a]
-> HVectorize [] (Columns a) Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> Columns a Expr) -> [a] -> [Columns a Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns


-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
-- have a 'ListTable' that you are storing in a table and need to construct a
-- 'TableSchema'.
nameListTable
  :: Table Name a
  => a -- ^ The names of the columns of elements of the list.
  -> ListTable Name a
nameListTable :: a -> ListTable Name a
nameListTable =
  HVectorize [] (Columns a) Name -> ListTable Name a
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable (HVectorize [] (Columns a) Name -> ListTable Name a)
-> (a -> HVectorize [] (Columns a) Name) -> a -> ListTable Name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. Spec a -> Identity (Name a) -> Name [a])
-> Identity (Columns a Name) -> HVectorize [] (Columns a) Name
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize (\Spec a
_ (Identity (Name a)) -> String -> Name [a]
forall a. String -> Name a
Name String
a) (Identity (Columns a Name) -> HVectorize [] (Columns a) Name)
-> (a -> Identity (Columns a Name))
-> a
-> HVectorize [] (Columns a) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Columns a Name -> Identity (Columns a Name)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columns a Name -> Identity (Columns a Name))
-> (a -> Columns a Name) -> a -> Identity (Columns a Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  a -> Columns a Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns