git.iko.soy/rel8
on d028b37 help sign in
rel8/src/Rel8/Column/List.hs
148 lines 4.4 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
7{-# language UndecidableInstances #-}
9module Rel8.Column.List
10 ( HList, AHList(..)
11 )
12where
14-- base
15import Data.Kind ( Type )
16import Data.Type.Equality ( (:~:)( Refl ) )
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 ( Unreifiability(..), Unreifiable, unreifiability )
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 (Reifiable context, Unreifiable a, Table (Reify context) a) =>
54 Table (Reify context) (AHList context a)
55 where
56 type Context (AHList context a) = Reify context
57 type Columns (AHList context a) = HListTable (Columns a)
58 type Unreify (AHList context a) = HList context (Unreify a)
60 fromColumns = sfromColumnsList contextSing
61 toColumns = stoColumnsList contextSing
63 reify _ = sreifyList (unreifiability contextSing)
64 unreify _ = sunreifyList (unreifiability contextSing)
67instance
68 ( Reifiable context, Reifiable context'
69 , Unreifiable a, Unreifiable a'
70 , Recontextualize (Reify context) (Reify context') a a'
71 )
72 => Recontextualize
73 (Reify context)
74 (Reify context')
75 (AHList context a)
76 (AHList context' a')
79smapList :: Congruent a b
80 => SContext context
81 -> (a -> b)
82 -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
83 -> AHList context a
84 -> AHList context b
85smapList = \case
86 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
87 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
88 SResult -> \f _ (AHList as) -> AHList (fmap f as)
89 SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
90 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
91 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
94sfromColumnsList :: Table (Reify context) a
95 => SContext context
96 -> HListTable (Columns a) (Col (Reify context))
97 -> AHList context a
98sfromColumnsList = \case
99 SAggregate -> AHList . ListTable
100 SExpr -> AHList . ListTable
101 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
102 SInsert -> AHList . ListTable
103 SName -> AHList . ListTable
104 SReify context ->
105 AHList .
106 smapList context (fromColumns . hreify) hreify .
107 sfromColumnsList context .
108 hunreify
111stoColumnsList :: Table (Reify context) a
112 => SContext context
113 -> AHList context a
114 -> HListTable (Columns a) (Col (Reify context))
115stoColumnsList = \case
116 SAggregate -> \(AHList (ListTable a)) -> a
117 SExpr -> \(AHList (ListTable a)) -> a
118 SResult ->
119 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
120 SInsert -> \(AHList (ListTable a)) -> a
121 SName -> \(AHList (ListTable a)) -> a
122 SReify context ->
123 hreify .
124 stoColumnsList context .
125 smapList context (hunreify . toColumns) hunreify .
126 (\(AHList a) -> a)
129sreifyList :: Table (Reify context) a
130 => Unreifiability context a
131 -> HList context (Unreify a)
132 -> AHList context a
133sreifyList = \case
134 UResult -> AHList . fmap (reify Refl)
135 Unreifiability context ->
136 smapList context (reify Refl) hreify .
137 AHList
140sunreifyList :: Table (Reify context) a
141 => Unreifiability context a
142 -> AHList context a
143 -> HList context (Unreify a)
144sunreifyList = \case
145 UResult -> fmap (unreify Refl) . (\(AHList a) -> a)
146 Unreifiability context ->
147 (\(AHList a) -> a) .
148 smapList context (unreify Refl) hunreify