git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/List.hs
133 lines 3.9 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language LambdaCase #-}
5{-# language MultiParamTypeClasses #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Column.List
11 ( HList, AHList(..)
12 )
13where
15-- base
16import Data.Kind ( Type )
17import Prelude
19-- rel8
20import Rel8.Aggregate ( Aggregate )
21import Rel8.Expr ( Expr )
22import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
23import Rel8.Schema.Context ( Col )
24import Rel8.Schema.HTable.List ( HListTable )
25import Rel8.Schema.Insert ( Insert )
26import qualified Rel8.Schema.Kind as K
27import Rel8.Schema.Name ( Name )
28import Rel8.Schema.Reify ( Reify, hreify, hunreify )
29import Rel8.Schema.Result ( Result )
30import Rel8.Table
31 ( Table, Columns, Congruent, Context, fromColumns, toColumns
32 , Unreify, reify, unreify
33 )
34import Rel8.Table.List ( ListTable( ListTable ) )
35import Rel8.Table.Recontextualize ( Recontextualize )
36import Rel8.Table.Unreify ( Unreifiable )
39type HList :: K.Context -> Type -> Type
40type family HList context where
41 HList (Reify context) = AHList context
42 HList Aggregate = ListTable
43 HList Expr = ListTable
44 HList Insert = ListTable
45 HList Name = ListTable
46 HList Result = []
49type AHList :: K.Context -> Type -> Type
50newtype AHList context a = AHList (HList context a)
53instance
54 ( Reifiable context
55 , Table (Reify context) a
56 , Unreifiable (Reify context) a
57 )
58 => Table (Reify context) (AHList context a)
59 where
60 type Context (AHList context a) = Reify context
61 type Columns (AHList context a) = HListTable (Columns a)
62 type Unreify (AHList context a) = HList context (Unreify a)
64 fromColumns = sfromColumnsList contextSing
65 toColumns = stoColumnsList contextSing
66 reify proof =
67 smapList contextSing (reify proof) hreify .
68 AHList
69 unreify proof =
70 (\(AHList a) -> a) .
71 smapList contextSing (unreify proof) hunreify
74instance
75 ( Reifiable context, Reifiable context'
76 , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
77 , Recontextualize (Reify context) (Reify context') a a'
78 ) =>
79 Recontextualize
80 (Reify context)
81 (Reify context')
82 (AHList context a)
83 (AHList context' a')
86smapList :: Congruent a b
87 => SContext context
88 -> (a -> b)
89 -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
90 -> AHList context a
91 -> AHList context b
92smapList = \case
93 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
94 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
95 SResult -> \f _ (AHList as) -> AHList (fmap f as)
96 SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
97 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
98 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
101sfromColumnsList :: Table (Reify context) a
102 => SContext context
103 -> HListTable (Columns a) (Col (Reify context))
104 -> AHList context a
105sfromColumnsList = \case
106 SAggregate -> AHList . ListTable
107 SExpr -> AHList . ListTable
108 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
109 SInsert -> AHList . ListTable
110 SName -> AHList . ListTable
111 SReify context ->
112 AHList .
113 smapList context (fromColumns . hreify) hreify .
114 sfromColumnsList context .
115 hunreify
118stoColumnsList :: Table (Reify context) a
119 => SContext context
120 -> AHList context a
121 -> HListTable (Columns a) (Col (Reify context))
122stoColumnsList = \case
123 SAggregate -> \(AHList (ListTable a)) -> a
124 SExpr -> \(AHList (ListTable a)) -> a
125 SResult ->
126 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
127 SInsert -> \(AHList (ListTable a)) -> a
128 SName -> \(AHList (ListTable a)) -> a
129 SReify context ->
130 hreify .
131 stoColumnsList context .
132 smapList context (hunreify . toColumns) hunreify .
133 (\(AHList a) -> a)