{-# 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
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Prelude
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 )
type ListTable :: K.Context -> Type -> Type
newtype ListTable context a =
ListTable (HListTable (Columns a) (Context a))
instance Projectable (ListTable context) where
project :: forall a b.
Projecting a b =>
Projection a b -> ListTable context a -> ListTable context b
project Projection a b
f (ListTable HListTable (Columns a) (Context a)
a) = forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable (forall (t :: HTable) (t' :: HTable) (list :: * -> *)
(context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HVectorize list t context -> HVectorize list t' context
hproject (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)
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 = 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) = HListTable (Columns a) (Context a)
a
fromResult :: Columns (ListTable context a) Result
-> FromExprs (ListTable context a)
fromResult = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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 (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 (f :: * -> *) a.
Functor f =>
Spec a -> f (Result a) -> Result (f a)
vectorizer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 (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 (Sql DBEq) a
Dict) -> case Nullity a
nullity of
Nullity a
Null -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(forall a. a -> Identity a
Identity (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 (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 (Sql DBOrd) a
Dict) -> case Nullity a
nullity of
Nullity a
Null -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(forall a. a -> Identity a
Identity (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
<|>: :: forall a.
Table Expr 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 :: forall a. Table Expr a => ListTable context a
emptyTable = 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 = forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable forall a b. (a -> b) -> a -> b
$ 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 (forall a b. a -> b -> a
const forall a. Expr [a] -> Expr [a] -> Expr [a]
sappend) HListTable (Columns a) (Context a)
as HListTable (Columns a) (Context a)
bs
instance (context ~ Expr, Table Expr a) =>
Monoid (ListTable context a)
where
mempty :: ListTable context a
mempty = forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context [a]) -> HVectorize [] t context
hempty forall a b. (a -> b) -> a -> b
$ \Spec {TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> forall a. TypeInformation (Unnullify a) -> Expr [a]
sempty TypeInformation (Unnullify a)
info
($*) :: Projecting a (Expr b)
=> Projection a (Expr b) -> ListTable Expr a -> Expr [b]
Projection a (Expr b)
f $* :: forall a b.
Projecting a (Expr b) =>
Projection a (Expr b) -> ListTable Expr a -> Expr [b]
$* ListTable HListTable (Columns a) (Context a)
a = forall (list :: * -> *) a (context :: * -> *).
HVectorize list (HIdentity a) context -> context (list a)
hcolumn forall a b. (a -> b) -> a -> b
$ forall (t :: HTable) (t' :: HTable) (list :: * -> *)
(context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HVectorize list t context -> HVectorize list t' context
hproject (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)
a
infixl 4 $*
listTable :: Table Expr a => [a] -> ListTable Expr a
listTable :: forall a. Table Expr a => [a] -> ListTable Expr a
listTable =
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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} -> forall a. TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
slistOf TypeInformation (Unnullify a)
info) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns
nameListTable
:: Table Name a
=> a
-> ListTable Name a
nameListTable :: forall a. Table Name a => a -> ListTable Name a
nameListTable =
forall (context :: * -> *) a.
HListTable (Columns a) (Context a) -> ListTable context a
ListTable forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 String
a)) -> forall a. String -> Name a
Name String
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns