{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language DefaultSignatures #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language FunctionalDependencies #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Rel8.Table
( Table
( Columns, Context, fromColumns, toColumns
, FromExprs, fromResult, toResult
, Transpose
)
, Congruent
, TTable, TColumns, TContext, TFromExprs, TTranspose
, TSerialize
)
where
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Constraint, Type )
import GHC.Generics ( Generic, Rep, from, to )
import Prelude hiding ( null )
import Rel8.FCF ( Eval, Exp )
import Rel8.Generic.Map ( Map )
import Rel8.Generic.Table.Record
( GTable, GColumns, GContext, gfromColumns, gtoColumns
, GSerialize, gfromResult, gtoResult
)
import Rel8.Generic.Record ( Record(..) )
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Result ( Result )
import Rel8.Type ( DBType )
type Table :: K.Context -> Type -> Constraint
class
( HTable (Columns a)
, context ~ Context a
, a ~ Transpose context a
)
=> Table context a | a -> context
where
type Columns a :: K.HTable
type Context a :: K.Context
type FromExprs a :: Type
type Transpose (context' :: K.Context) a :: Type
toColumns :: a -> Columns a context
fromColumns :: Columns a context -> a
fromResult :: Columns a Result -> FromExprs a
toResult :: FromExprs a -> Columns a Result
type Columns a = GColumns TColumns (Rep (Record a))
type Context a = GContext TContext (Rep (Record a))
type FromExprs a = Map TFromExprs a
type Transpose context a = Map (TTranspose context) a
default toColumns ::
( Generic (Record a)
, GTable (TTable context) TColumns (Rep (Record a))
, Columns a ~ GColumns TColumns (Rep (Record a))
)
=> a -> Columns a context
toColumns =
(forall a.
Eval (TTable context a) =>
a -> Eval (TColumns a) context)
-> GRecord (Rep a) Any
-> GColumns TColumns (GRecord (Rep a)) context
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (rep :: * -> *) (context :: * -> *)
x.
GTable _Table _Columns rep =>
(forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
-> rep x -> GColumns _Columns rep context
gtoColumns @(TTable context) @TColumns forall a. Eval (TTable context a) => a -> Eval (TColumns a) context
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns (GRecord (Rep a) Any -> Columns a context)
-> (a -> GRecord (Rep a) Any) -> a -> Columns a context
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Record a -> GRecord (Rep a) Any
forall a x. Generic a => a -> Rep a x
from (Record a -> GRecord (Rep a) Any)
-> (a -> Record a) -> a -> GRecord (Rep a) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
a -> Record a
forall a. a -> Record a
Record
default fromColumns ::
( Generic (Record a)
, GTable (TTable context) TColumns (Rep (Record a))
, Columns a ~ GColumns TColumns (Rep (Record a))
)
=> Columns a context -> a
fromColumns =
Record a -> a
forall a. Record a -> a
unrecord (Record a -> a)
-> (Columns a context -> Record a) -> Columns a context -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
GRecord (Rep a) Any -> Record a
forall a x. Generic a => Rep a x -> a
to (GRecord (Rep a) Any -> Record a)
-> (Columns a context -> GRecord (Rep a) Any)
-> Columns a context
-> Record a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a.
Eval (TTable context a) =>
Eval (TColumns a) context -> a)
-> GColumns TColumns (GRecord (Rep a)) context
-> GRecord (Rep a) Any
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (rep :: * -> *) (context :: * -> *)
x.
GTable _Table _Columns rep =>
(forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
-> GColumns _Columns rep context -> rep x
gfromColumns @(TTable context) @TColumns forall a. Eval (TTable context a) => Eval (TColumns a) context -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns
default toResult ::
( Generic (Record (FromExprs a))
, GSerialize TSerialize TColumns (Rep (Record a)) (Rep (Record (FromExprs a)))
, Columns a ~ GColumns TColumns (Rep (Record a))
)
=> FromExprs a -> Columns a Result
toResult =
(forall expr a (proxy :: * -> *).
Eval (TSerialize expr a) =>
proxy expr -> a -> Eval (TColumns expr) Result)
-> Rep (Record (FromExprs a)) Any
-> GColumns TColumns (Rep (Record a)) Result
forall (_Serialize :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *)
(context :: * -> *) x.
GSerialize _Serialize _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
Eval (_Serialize expr a) =>
proxy expr -> a -> Eval (_Columns expr) context)
-> rep x -> GColumns _Columns exprs context
gtoResult
@TSerialize
@TColumns
@(Rep (Record a))
@(Rep (Record (FromExprs a)))
(\(proxy expr
_ :: proxy x) -> Table (Context expr) expr => FromExprs expr -> Columns expr Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @(Context x) @x) (GRecord (Rep (FromExprs a)) Any -> Columns a Result)
-> (FromExprs a -> GRecord (Rep (FromExprs a)) Any)
-> FromExprs a
-> Columns a Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Record (FromExprs a) -> GRecord (Rep (FromExprs a)) Any
forall a x. Generic a => a -> Rep a x
from (Record (FromExprs a) -> GRecord (Rep (FromExprs a)) Any)
-> (FromExprs a -> Record (FromExprs a))
-> FromExprs a
-> GRecord (Rep (FromExprs a)) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FromExprs a -> Record (FromExprs a)
forall a. a -> Record a
Record
default fromResult ::
( Generic (Record (FromExprs a))
, GSerialize TSerialize TColumns (Rep (Record a)) (Rep (Record (FromExprs a)))
, Columns a ~ GColumns TColumns (Rep (Record a))
)
=> Columns a Result -> FromExprs a
fromResult =
Record (FromExprs a) -> FromExprs a
forall a. Record a -> a
unrecord (Record (FromExprs a) -> FromExprs a)
-> (Columns a Result -> Record (FromExprs a))
-> Columns a Result
-> FromExprs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
GRecord (Rep (FromExprs a)) Any -> Record (FromExprs a)
forall a x. Generic a => Rep a x -> a
to (GRecord (Rep (FromExprs a)) Any -> Record (FromExprs a))
-> (Columns a Result -> GRecord (Rep (FromExprs a)) Any)
-> Columns a Result
-> Record (FromExprs a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall expr a (proxy :: * -> *).
Eval (TSerialize expr a) =>
proxy expr -> Eval (TColumns expr) Result -> a)
-> GColumns TColumns (Rep (Record a)) Result
-> Rep (Record (FromExprs a)) Any
forall (_Serialize :: * -> * -> Exp Constraint)
(_Columns :: * -> Exp HTable) (exprs :: * -> *) (rep :: * -> *)
(context :: * -> *) x.
GSerialize _Serialize _Columns exprs rep =>
(forall expr a (proxy :: * -> *).
Eval (_Serialize expr a) =>
proxy expr -> Eval (_Columns expr) context -> a)
-> GColumns _Columns exprs context -> rep x
gfromResult
@TSerialize
@TColumns
@(Rep (Record a))
@(Rep (Record (FromExprs a)))
(\(proxy expr
_ :: proxy x) -> Table (Context expr) expr => Columns expr Result -> FromExprs expr
forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @(Context x) @x)
instance Sql DBType a => Table Result (Identity a) where
type Columns (Identity a) = HIdentity a
type Context (Identity a) = Result
type FromExprs (Identity a) = a
type Transpose to (Identity a) = to a
toColumns :: Identity a -> Columns (Identity a) Result
toColumns = Identity a -> Columns (Identity a) Result
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity
fromColumns :: Columns (Identity a) Result -> Identity a
fromColumns (HIdentity a) = Identity a
a
toResult :: FromExprs (Identity a) -> Columns (Identity a) Result
toResult FromExprs (Identity a)
a = Identity a -> HIdentity a Result
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (a -> Identity a
forall a. a -> Identity a
Identity a
FromExprs (Identity a)
a)
fromResult :: Columns (Identity a) Result -> FromExprs (Identity a)
fromResult (HIdentity (Identity a)) = a
FromExprs (Identity a)
a
data TTable :: K.Context -> Type -> Exp Constraint
type instance Eval (TTable context a) = Table context a
data TColumns :: Type -> Exp K.HTable
type instance Eval (TColumns a) = Columns a
data TContext :: Type -> Exp K.Context
type instance Eval (TContext a) = Context a
data TFromExprs :: Type -> Exp Type
type instance Eval (TFromExprs a) = FromExprs a
data TTranspose :: K.Context -> Type -> Exp Type
type instance Eval (TTranspose context a) = Transpose context a
data TSerialize :: Type -> Type -> Exp Constraint
type instance Eval (TSerialize expr a) =
( Table (Context expr) expr
, a ~ FromExprs expr
)
instance (Table context a, Table context b) => Table context (a, b)
instance
( Table context a, Table context b, Table context c
)
=> Table context (a, b, c)
instance
( Table context a, Table context b, Table context c, Table context d
)
=> Table context (a, b, c, d)
instance
( Table context a, Table context b, Table context c, Table context d
, Table context e
)
=> Table context (a, b, c, d, e)
instance
( Table context a, Table context b, Table context c, Table context d
, Table context e, Table context f
)
=> Table context (a, b, c, d, e, f)
instance
( Table context a, Table context b, Table context c, Table context d
, Table context e, Table context f, Table context g
)
=> Table context (a, b, c, d, e, f, g)
type Congruent :: Type -> Type -> Constraint
class Columns a ~ Columns b => Congruent a b
instance Columns a ~ Columns b => Congruent a b