git.iko.soy/rel8
on 7f5801f help sign in
rel8/src/Rel8/Column/List.hs
143 lines 4.2 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 qualified Rel8.Schema.Kind as K
26import Rel8.Schema.Name ( Name )
27import Rel8.Schema.Reify ( Reify, hreify, hunreify )
28import Rel8.Schema.Result ( Result )
29import Rel8.Table
30 ( Table, Columns, Congruent, Context, fromColumns, toColumns
31 , Unreify, reify, unreify
32 )
33import Rel8.Table.List ( ListTable( ListTable ) )
34import Rel8.Table.Recontextualize ( Recontextualize )
35import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability )
38type HList :: K.Context -> Type -> Type
39type family HList context where
40 HList (Reify context) = AHList context
41 HList Aggregate = ListTable
42 HList Expr = ListTable
43 HList Name = ListTable
44 HList Result = []
47type AHList :: K.Context -> Type -> Type
48newtype AHList context a = AHList (HList context a)
51instance (Reifiable context, Unreifiable a, Table (Reify context) a) =>
52 Table (Reify context) (AHList context a)
53 where
54 type Context (AHList context a) = Reify context
55 type Columns (AHList context a) = HListTable (Columns a)
56 type Unreify (AHList context a) = HList context (Unreify a)
58 fromColumns = sfromColumnsList contextSing
59 toColumns = stoColumnsList contextSing
61 reify _ = sreifyList (unreifiability contextSing)
62 unreify _ = sunreifyList (unreifiability contextSing)
65instance
66 ( Reifiable context, Reifiable context'
67 , Unreifiable a, Unreifiable a'
68 , Recontextualize (Reify context) (Reify context') a a'
69 )
70 => Recontextualize
71 (Reify context)
72 (Reify context')
73 (AHList context a)
74 (AHList context' a')
77smapList :: Congruent a b
78 => SContext context
79 -> (a -> b)
80 -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
81 -> AHList context a
82 -> AHList context b
83smapList = \case
84 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
85 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
86 SResult -> \f _ (AHList as) -> AHList (fmap f as)
87 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
88 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
91sfromColumnsList :: Table (Reify context) a
92 => SContext context
93 -> HListTable (Columns a) (Col (Reify context))
94 -> AHList context a
95sfromColumnsList = \case
96 SAggregate -> AHList . ListTable
97 SExpr -> AHList . ListTable
98 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
99 SName -> AHList . ListTable
100 SReify context ->
101 AHList .
102 smapList context (fromColumns . hreify) hreify .
103 sfromColumnsList context .
104 hunreify
107stoColumnsList :: Table (Reify context) a
108 => SContext context
109 -> AHList context a
110 -> HListTable (Columns a) (Col (Reify context))
111stoColumnsList = \case
112 SAggregate -> \(AHList (ListTable a)) -> a
113 SExpr -> \(AHList (ListTable a)) -> a
114 SResult ->
115 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
116 SName -> \(AHList (ListTable a)) -> a
117 SReify context ->
118 hreify .
119 stoColumnsList context .
120 smapList context (hunreify . toColumns) hunreify .
121 (\(AHList a) -> a)
124sreifyList :: Table (Reify context) a
125 => Unreifiability context a
126 -> HList context (Unreify a)
127 -> AHList context a
128sreifyList = \case
129 UResult -> AHList . fmap (reify Refl)
130 Unreifiability context ->
131 smapList context (reify Refl) hreify .
132 AHList
135sunreifyList :: Table (Reify context) a
136 => Unreifiability context a
137 -> AHList context a
138 -> HList context (Unreify a)
139sunreifyList = \case
140 UResult -> fmap (unreify Refl) . (\(AHList a) -> a)
141 Unreifiability context ->
142 (\(AHList a) -> a) .
143 smapList context (unreify Refl) hunreify