on dc69cca help sign in
90 lines 2.5 kB history raw
1{-# language DataKinds #-}
2{-# language LambdaCase #-}
3{-# language MultiParamTypeClasses #-}
4{-# language StandaloneKindSignatures #-}
5{-# language TypeFamilies #-}
6{-# language UndecidableInstances #-}
8module Rel8.Column.ADT
9 ( HADT, AHADT(..)
10 )
11where
13-- base
14import Data.Kind ( Type )
15import Prelude
17-- rel8
18import Rel8.Generic.Rel8able ( GColumns )
19import Rel8.Kind.Context ( SContext(..), Reifiable, contextSing )
20import Rel8.Schema.Context ( Col )
21import qualified Rel8.Schema.Kind as K
22import Rel8.Schema.Reify ( Reify, hreify, hunreify )
23import Rel8.Schema.Result ( Result )
24import Rel8.Table
25 ( Table, Columns, Context, fromColumns, toColumns
26 , Unreify, reify, unreify
27 )
28import Rel8.Table.ADT ( ADT( ADT ), ADTable, fromADT, toADT )
29import Rel8.Table.Recontextualize ( Recontextualize )
32type HADT :: K.Context -> K.Rel8able -> Type
33type family HADT context t where
34 HADT (Reify context) t = AHADT context t
35 HADT Result t = t Result
36 HADT context t = ADT t context
39type AHADT :: K.Context -> K.Rel8able -> Type
40newtype AHADT context t = AHADT (HADT context t)
43instance (ADTable t, Reifiable context) =>
44 Table (Reify context) (AHADT context t)
45 where
46 type Context (AHADT context t) = Reify context
47 type Columns (AHADT context t) = GColumns (ADT t)
48 type Unreify (AHADT context t) = HADT context t
50 fromColumns = sfromColumnsADT contextSing
51 toColumns = stoColumnsADT contextSing
52 reify _ = AHADT
53 unreify _ (AHADT a) = a
56instance
57 ( Reifiable context, Reifiable context'
58 , ADTable t, t ~ t'
59 )
60 => Recontextualize
61 (Reify context)
62 (Reify context')
63 (AHADT context t)
64 (AHADT context' t')
67sfromColumnsADT :: ADTable t
68 => SContext context
69 -> GColumns (ADT t) (Col (Reify context))
70 -> AHADT context t
71sfromColumnsADT = \case
72 SAggregate -> AHADT . ADT . hunreify
73 SExpr -> AHADT . ADT . hunreify
74 SInsert -> AHADT . ADT . hunreify
75 SName -> AHADT . ADT . hunreify
76 SResult -> AHADT . fromADT . ADT . hunreify
77 SReify context -> AHADT . sfromColumnsADT context . hunreify
80stoColumnsADT :: ADTable t
81 => SContext context
82 -> AHADT context t
83 -> GColumns (ADT t) (Col (Reify context))
84stoColumnsADT = \case
85 SAggregate -> hreify . (\(AHADT (ADT a)) -> a)
86 SExpr -> hreify . (\(AHADT (ADT a)) -> a)
87 SInsert -> hreify . (\(AHADT (ADT a)) -> a)
88 SName -> hreify . (\(AHADT (ADT a)) -> a)
89 SResult -> hreify . (\(ADT a) -> a) . toADT . (\(AHADT a) -> a)
90 SReify context -> hreify . stoColumnsADT context . (\(AHADT a) -> a)