git.iko.soy/rel8
on f8b1a55 help sign in
rel8/src/Rel8/Column/List.hs
147 lines 4.3 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
37 ( Unreifiability( Unreifiability )
38 , Unreifiable, unreifiability
39 )
42type HList :: K.Context -> Type -> Type
43type family HList context where
44 HList (Reify context) = AHList context
45 HList Aggregate = ListTable
46 HList Expr = ListTable
47 HList Insert = ListTable
48 HList Name = ListTable
49 HList Result = []
52type AHList :: K.Context -> Type -> Type
53newtype AHList context a = AHList (HList context a)
56instance (Reifiable context, Unreifiable a, Table (Reify context) a) =>
57 Table (Reify context) (AHList context a)
58 where
59 type Context (AHList context a) = Reify context
60 type Columns (AHList context a) = HListTable (Columns a)
61 type Unreify (AHList context a) = HList context (Unreify a)
63 fromColumns = sfromColumnsList contextSing
64 toColumns = stoColumnsList contextSing
66 reify _ = sreifyList (unreifiability contextSing)
67 unreify _ = sunreifyList (unreifiability contextSing)
70instance
71 ( Reifiable context, Reifiable context'
72 , Unreifiable a, Unreifiable a'
73 , Recontextualize (Reify context) (Reify context') a a'
74 )
75 => Recontextualize
76 (Reify context)
77 (Reify context')
78 (AHList context a)
79 (AHList context' a')
82smapList :: Congruent a b
83 => SContext context
84 -> (a -> b)
85 -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
86 -> AHList context a
87 -> AHList context b
88smapList = \case
89 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
90 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
91 SResult -> \f _ (AHList as) -> AHList (fmap f as)
92 SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
93 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
94 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
97sfromColumnsList :: Table (Reify context) a
98 => SContext context
99 -> HListTable (Columns a) (Col (Reify context))
100 -> AHList context a
101sfromColumnsList = \case
102 SAggregate -> AHList . ListTable
103 SExpr -> AHList . ListTable
104 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
105 SInsert -> AHList . ListTable
106 SName -> AHList . ListTable
107 SReify context ->
108 AHList .
109 smapList context (fromColumns . hreify) hreify .
110 sfromColumnsList context .
111 hunreify
114stoColumnsList :: Table (Reify context) a
115 => SContext context
116 -> AHList context a
117 -> HListTable (Columns a) (Col (Reify context))
118stoColumnsList = \case
119 SAggregate -> \(AHList (ListTable a)) -> a
120 SExpr -> \(AHList (ListTable a)) -> a
121 SResult ->
122 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
123 SInsert -> \(AHList (ListTable a)) -> a
124 SName -> \(AHList (ListTable a)) -> a
125 SReify context ->
126 hreify .
127 stoColumnsList context .
128 smapList context (hunreify . toColumns) hunreify .
129 (\(AHList a) -> a)
132sreifyList :: ()
133 => Unreifiability context a
134 -> HList context (Unreify a)
135 -> AHList context a
136sreifyList (Unreifiability context) =
137 smapList context (reify Refl) hreify .
138 AHList
141sunreifyList :: ()
142 => Unreifiability context a
143 -> AHList context a
144 -> HList context (Unreify a)
145sunreifyList (Unreifiability context) =
146 (\(AHList a) -> a) .
147 smapList context (unreify Refl) hunreify