git.iko.soy/rel8
on be54907 help sign in
rel8/src/Rel8/Table/List.hs
161 lines 4.8 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
6{-# language ScopedTypeVariables #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeApplications #-}
9{-# language TypeFamilies #-}
10{-# language UndecidableInstances #-}
12module Rel8.Table.List
13 ( ListTable(..)
14 , listTable, nameListTable
15 )
16where
18-- base
19import Control.Category ( id )
20import Data.Functor.Identity ( Identity( Identity ) )
21import Data.Kind ( Type )
22import Data.Type.Equality ( (:~:)( Refl ), apply )
23import Prelude hiding ( id )
25-- rel8
26import Rel8.Expr ( Expr, Col( E, unE ) )
27import Rel8.Expr.Array ( sappend, sempty, slistOf )
28import Rel8.Schema.Context.Abstract ( Abstract, exclusivity, virtual )
29import Rel8.Schema.Dict ( Dict( Dict ) )
30import Rel8.Schema.HTable.List ( HListTable )
31import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
32import qualified Rel8.Schema.Kind as K
33import Rel8.Schema.Name ( Col( N ), Name( Name ) )
34import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
35import Rel8.Schema.Spec ( SSpec(..) )
36import Rel8.Schema.Reify ( hreify, hunreify )
37import Rel8.Table
38 ( Table, Context, Columns, fromColumns, toColumns
39 , reify, unreify, coherence, congruence
40 )
41import Rel8.Table.Alternative
42 ( AltTable, (<|>:)
43 , AlternativeTable, emptyTable
44 )
45import Rel8.Table.Eq ( EqTable, eqTable )
46import Rel8.Table.Ord ( OrdTable, ordTable )
47import Rel8.Table.Recontextualize ( Recontextualize )
48import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
51-- | A @ListTable@ value contains zero or more instances of @a@. You construct
52-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
53type ListTable :: K.Context -> Type -> Type
54newtype ListTable context a =
55 ListTable (HListTable (Columns a) (Col (Context a)))
58instance (Table context a, Abstract context, context ~ context') =>
59 Table context' (ListTable context a)
60 where
61 type Columns (ListTable context a) = HListTable (Columns a)
62 type Context (ListTable context a) = Context a
64 fromColumns = ListTable
65 toColumns (ListTable a) = a
67 reify proof@Refl (ListTable a) =
68 case coherence @context @a proof abstract of
69 Refl -> case congruence @context @a proof abstract of
70 Refl -> ListTable (hreify a)
71 where
72 abstract = exclusivity virtual
74 unreify proof@Refl (ListTable a) =
75 case coherence @context @a proof abstract of
76 Refl -> case congruence @context @a proof abstract of
77 Refl -> ListTable (hunreify a)
78 where
79 abstract = exclusivity virtual
81 coherence = coherence @context @a
82 congruence proof abstract = id `apply` congruence @context @a proof abstract
85instance
86 ( Recontextualize from to a b
87 , Abstract from, from ~ from'
88 , Abstract to, to ~ to'
89 )
90 => Recontextualize from to (ListTable from' a) (ListTable to' b)
93instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
94 eqTable =
95 hvectorize
96 (\SSpec {nullity} (Identity Dict) -> case nullity of
97 Null -> Dict
98 NotNull -> Dict)
99 (Identity (eqTable @a))
102instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
103 ordTable =
104 hvectorize
105 (\SSpec {nullity} (Identity Dict) -> case nullity of
106 Null -> Dict
107 NotNull -> Dict)
108 (Identity (ordTable @a))
111type instance FromExprs (ListTable _context a) = [FromExprs a]
114instance (ToExprs exprs a, context ~ Expr) =>
115 ToExprs (ListTable context exprs) [a]
116 where
117 fromResult = fmap (fromResult @exprs) . fromColumns
118 toResult = toColumns . fmap (toResult @exprs)
121instance context ~ Expr => AltTable (ListTable context) where
122 (<|>:) = (<>)
125instance context ~ Expr => AlternativeTable (ListTable context) where
126 emptyTable = mempty
129instance (context ~ Expr, Table Expr a) =>
130 Semigroup (ListTable context a)
131 where
132 ListTable as <> ListTable bs = ListTable $
133 happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs
136instance (context ~ Expr, Table Expr a) =>
137 Monoid (ListTable context a)
138 where
139 mempty = ListTable $ hempty $ \_ -> E . sempty
142-- | Construct a @ListTable@ from a list of expressions.
143listTable :: Table Expr a => [a] -> ListTable Expr a
144listTable =
145 ListTable .
146 hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
147 fmap toColumns
150-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
151-- have a 'ListTable' that you are storing in a table and need to construct a
152-- 'TableSchema'.
153nameListTable
154 :: Table Name a
155 => a -- ^ The names of the columns of elements of the list.
156 -> ListTable Name a
157nameListTable =
158 ListTable .
159 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
160 pure .
161 toColumns