{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Rel8.Table.List
( ListTable(..)
, listTable, insertListTable, nameListTable
)
where
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Data.Type.Equality ( (:~:)( Refl ) )
import Prelude
import Rel8.Expr ( Expr, Col( E, unE ) )
import Rel8.Expr.Array ( sappend, sempty, slistOf )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable.List ( HListTable )
import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
import Rel8.Schema.Insert ( Inserts )
import Rel8.Schema.Name ( Col( N ), Name( Name ) )
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import Rel8.Schema.Spec ( SSpec(..) )
import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
import Rel8.Schema.Reify ( hreify, hunreify )
import Rel8.Table
( Table, Context, Columns, fromColumns, toColumns
, reify, unreify
)
import Rel8.Table.Alternative
( AltTable, (<|>:)
, AlternativeTable, emptyTable
)
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Insert ( toInsert )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
import Rel8.Table.Unreify ( Unreifies )
type ListTable :: Type -> Type
newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
instance (Table context a, Unreifies context a) =>
Table context (ListTable a)
where
type Columns (ListTable a) = HListTable (Columns a)
type Context (ListTable a) = Context a
fromColumns :: Columns (ListTable a) (Col context) -> ListTable a
fromColumns = Columns (ListTable a) (Col context) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable
toColumns :: ListTable a -> Columns (ListTable a) (Col context)
toColumns (ListTable HListTable (Columns a) (Col (Context a))
a) = HListTable (Columns a) (Col (Context a))
Columns (ListTable a) (Col context)
a
reify :: (context :~: Reify ctx) -> Unreify (ListTable a) -> ListTable a
reify context :~: Reify ctx
Refl (ListTable a) = HListTable (Columns a) (Col (Context a)) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable (HVectorize [] (Columns a) (Col ctx)
-> HVectorize [] (Columns a) (Col (Reify ctx))
forall (t :: HTable) (context :: Context).
HTable t =>
t (Col context) -> t (Col (Reify context))
hreify HVectorize [] (Columns a) (Col ctx)
HListTable (Columns (Unreify a)) (Col (Context (Unreify a)))
a)
unreify :: (context :~: Reify ctx) -> ListTable a -> Unreify (ListTable a)
unreify context :~: Reify ctx
Refl (ListTable HListTable (Columns a) (Col (Context a))
a) = HListTable (Columns (Unreify a)) (Col (Context (Unreify a)))
-> ListTable (Unreify a)
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable (HVectorize [] (Columns a) (Col (Reify ctx))
-> HVectorize [] (Columns a) (Col ctx)
forall (t :: HTable) (context :: Context).
HTable t =>
t (Col (Reify context)) -> t (Col context)
hunreify HVectorize [] (Columns a) (Col (Reify ctx))
HListTable (Columns a) (Col (Context a))
a)
instance
( Unreifies from a, Unreifies to b
, Recontextualize from to a b
)
=> Recontextualize from to (ListTable a) (ListTable b)
instance EqTable a => EqTable (ListTable a) where
eqTable :: Columns (ListTable a) (Dict (ConstrainDBType DBEq))
eqTable =
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Identity
(Dict (ConstrainDBType DBEq) ('Spec labels necessity a))
-> Dict (ConstrainDBType DBEq) ('Spec labels 'Required [a]))
-> Identity (Columns a (Dict (ConstrainDBType DBEq)))
-> HVectorize [] (Columns a) (Dict (ConstrainDBType DBEq))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> f (context ('Spec labels necessity a))
-> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
(\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
-> Dict DBEq (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
dict of
Dict DBEq (Unnullify a)
Dict -> case Dict (ConstrainDBType DBEq) ('Spec labels necessity a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
dict of
Nullity a
Null -> Dict (ConstrainDBType DBEq) ('Spec labels 'Required [a])
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> Dict (ConstrainDBType DBEq) ('Spec labels 'Required [a])
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(Columns a (Dict (ConstrainDBType DBEq))
-> Identity (Columns a (Dict (ConstrainDBType DBEq)))
forall a. a -> Identity a
Identity (EqTable a => Columns a (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @a))
instance OrdTable a => OrdTable (ListTable a) where
ordTable :: Columns (ListTable a) (Dict (ConstrainDBType DBOrd))
ordTable =
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Identity
(Dict (ConstrainDBType DBOrd) ('Spec labels necessity a))
-> Dict (ConstrainDBType DBOrd) ('Spec labels 'Required [a]))
-> Identity (Columns a (Dict (ConstrainDBType DBOrd)))
-> HVectorize [] (Columns a) (Dict (ConstrainDBType DBOrd))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> f (context ('Spec labels necessity a))
-> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
(\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
-> Dict DBOrd (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
dict of
Dict DBOrd (Unnullify a)
Dict -> case Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
-> Nullity a
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
dict of
Nullity a
Null -> Dict (ConstrainDBType DBOrd) ('Spec labels 'Required [a])
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> Dict (ConstrainDBType DBOrd) ('Spec labels 'Required [a])
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(Columns a (Dict (ConstrainDBType DBOrd))
-> Identity (Columns a (Dict (ConstrainDBType DBOrd)))
forall a. a -> Identity a
Identity (OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @a))
type instance FromExprs (ListTable a) = [FromExprs a]
instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where
fromResult :: Columns (ListTable exprs) (Col Result) -> [a]
fromResult = (Columns exprs (Col Result) -> a)
-> [Columns exprs (Col Result)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToExprs exprs a => Columns exprs (Col Result) -> a
forall exprs a. ToExprs exprs a => Columns exprs (Col Result) -> a
fromResult @exprs) ([Columns exprs (Col Result)] -> [a])
-> (HVectorize [] (Columns exprs) (Col Result)
-> [Columns exprs (Col Result)])
-> HVectorize [] (Columns exprs) (Col Result)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HVectorize [] (Columns exprs) (Col Result)
-> [Columns exprs (Col Result)]
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns
toResult :: [a] -> Columns (ListTable exprs) (Col Result)
toResult = [Columns exprs (Col Result)]
-> HVectorize [] (Columns exprs) (Col Result)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns ([Columns exprs (Col Result)]
-> HVectorize [] (Columns exprs) (Col Result))
-> ([a] -> [Columns exprs (Col Result)])
-> [a]
-> HVectorize [] (Columns exprs) (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Columns exprs (Col Result))
-> [a] -> [Columns exprs (Col Result)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToExprs exprs a => a -> Columns exprs (Col Result)
forall exprs a. ToExprs exprs a => a -> Columns exprs (Col Result)
toResult @exprs)
instance AltTable ListTable where
<|>: :: ListTable a -> ListTable a -> ListTable a
(<|>:) = ListTable a -> ListTable a -> ListTable a
forall a. Semigroup a => a -> a -> a
(<>)
instance AlternativeTable ListTable where
emptyTable :: ListTable a
emptyTable = ListTable a
forall a. Monoid a => a
mempty
instance Table Expr a => Semigroup (ListTable a) where
ListTable HListTable (Columns a) (Col (Context a))
as <> :: ListTable a -> ListTable a -> ListTable a
<> ListTable HListTable (Columns a) (Col (Context a))
bs = 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)) -> ListTable a)
-> HListTable (Columns a) (Col (Context a)) -> ListTable a
forall a b. (a -> b) -> a -> b
$
(forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels necessity [a])
-> Col Expr ('Spec labels necessity [a])
-> Col Expr ('Spec labels necessity [a]))
-> HVectorize [] (Columns a) (Col Expr)
-> HVectorize [] (Columns a) (Col Expr)
-> HVectorize [] (Columns a) (Col Expr)
forall (t :: HTable) (list :: * -> *) (context :: HContext).
(HTable t, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> context ('Spec labels necessity (list a))
-> context ('Spec labels necessity (list a))
-> context ('Spec labels necessity (list a)))
-> HVectorize list t context
-> HVectorize list t context
-> HVectorize list t context
happend (\Nullity a
_ TypeInformation (Unnullify a)
_ (E a) (E b) -> 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] -> Expr [a] -> Expr [a]
forall a. Expr [a] -> Expr [a] -> Expr [a]
sappend Expr a
Expr [a]
a Expr a
Expr [a]
b)) HVectorize [] (Columns a) (Col Expr)
HListTable (Columns a) (Col (Context a))
as HVectorize [] (Columns a) (Col Expr)
HListTable (Columns a) (Col (Context a))
bs
instance Table Expr a => Monoid (ListTable a) where
mempty :: ListTable a
mempty = 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)) -> ListTable a)
-> HListTable (Columns a) (Col (Context a)) -> ListTable a
forall a b. (a -> b) -> a -> b
$ (forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels necessity [a]))
-> HVectorize [] (Columns a) (Col Expr)
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> context ('Spec labels necessity [a]))
-> HVectorize [] t context
hempty ((forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels necessity [a]))
-> HVectorize [] (Columns a) (Col Expr))
-> (forall (labels :: Labels) (necessity :: Necessity) a.
Nullity a
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels necessity [a]))
-> HVectorize [] (Columns a) (Col Expr)
forall a b. (a -> b) -> a -> b
$ \Nullity a
_ -> 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]))
-> (TypeInformation (Unnullify a) -> Expr [a])
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels necessity [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation (Unnullify a) -> Expr [a]
forall a. TypeInformation (Unnullify a) -> Expr [a]
sempty
listTable :: Table Expr a => [a] -> ListTable a
listTable :: [a] -> ListTable a
listTable =
HVectorize [] (Columns a) (Col Expr) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable (HVectorize [] (Columns a) (Col Expr) -> ListTable a)
-> ([a] -> HVectorize [] (Columns a) (Col Expr))
-> [a]
-> ListTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> [Col Expr ('Spec labels necessity a)]
-> Col Expr ('Spec labels 'Required [a]))
-> [Columns a (Col Expr)] -> HVectorize [] (Columns a) (Col Expr)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> f (context ('Spec labels necessity a))
-> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec {TypeInformation (Unnullify a)
info :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> Expr [a] -> Col Expr ('Spec labels 'Required [a])
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr [a] -> Col Expr ('Spec labels 'Required [a]))
-> ([Col Expr ('Spec labels necessity a)] -> Expr [a])
-> [Col Expr ('Spec labels necessity a)]
-> Col Expr ('Spec labels 'Required [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
forall a. TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
slistOf TypeInformation (Unnullify a)
TypeInformation (Unnullify a)
info ([Expr a] -> Expr [a])
-> ([Col Expr ('Spec labels necessity a)] -> [Expr a])
-> [Col Expr ('Spec labels necessity a)]
-> Expr [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Col Expr ('Spec labels necessity a) -> Expr a)
-> [Col Expr ('Spec labels necessity a)] -> [Expr a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Col Expr ('Spec labels necessity a) -> Expr a
forall (labels :: Labels) (necessity :: Necessity) a.
Col Expr ('Spec labels necessity a) -> Expr a
unE) ([Columns a (Col Expr)] -> HVectorize [] (Columns a) (Col Expr))
-> ([a] -> [Columns a (Col Expr)])
-> [a]
-> HVectorize [] (Columns a) (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> Columns a (Col Expr)) -> [a] -> [Columns a (Col Expr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns
insertListTable :: Inserts exprs inserts => [exprs] -> ListTable inserts
insertListTable :: [exprs] -> ListTable inserts
insertListTable = ListTable exprs -> ListTable inserts
forall exprs inserts. Inserts exprs inserts => exprs -> inserts
toInsert (ListTable exprs -> ListTable inserts)
-> ([exprs] -> ListTable exprs) -> [exprs] -> ListTable inserts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [exprs] -> ListTable exprs
forall a. Table Expr a => [a] -> ListTable a
listTable
nameListTable :: Table Name a => a -> ListTable a
nameListTable :: a -> ListTable a
nameListTable =
HVectorize [] (Columns a) (Col Name) -> ListTable a
forall a. HListTable (Columns a) (Col (Context a)) -> ListTable a
ListTable (HVectorize [] (Columns a) (Col Name) -> ListTable a)
-> (a -> HVectorize [] (Columns a) (Col Name)) -> a -> ListTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> Identity (Col Name ('Spec labels necessity a))
-> Col Name ('Spec labels 'Required [a]))
-> Identity (Columns a (Col Name))
-> HVectorize [] (Columns a) (Col Name)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a)
-> f (context ('Spec labels necessity a))
-> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec ('Spec labels necessity a)
_ (Identity (N (Name a))) -> Name [a] -> Col Name ('Spec labels 'Required [a])
forall a (labels :: Labels) (necessity :: Necessity).
Name a -> Col Name ('Spec labels necessity a)
N (String -> Name [a]
forall k (a :: k). (k ~ *) => String -> Name a
Name String
a)) (Identity (Columns a (Col Name))
-> HVectorize [] (Columns a) (Col Name))
-> (a -> Identity (Columns a (Col Name)))
-> a
-> HVectorize [] (Columns a) (Col Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Columns a (Col Name) -> Identity (Columns a (Col Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columns a (Col Name) -> Identity (Columns a (Col Name)))
-> (a -> Columns a (Col Name))
-> a
-> Identity (Columns a (Col Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
a -> Columns a (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns