git.iko.soy/rel8
on 97d89cf help sign in
rel8/src/Rel8/Table/List.hs
134 lines 3.9 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 Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Type )
21import Prelude
23-- rel8
24import Rel8.Expr ( Expr( E, unE ) )
25import Rel8.Expr.Array ( sappend, sempty, slistOf )
26import Rel8.Schema.Dict ( Dict( Dict ) )
27import Rel8.Schema.HTable.List ( HListTable )
28import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize, hunvectorize )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.Name ( Name( N, Name ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Result ( vectorizer, unvectorizer )
33import Rel8.Schema.Spec ( SSpec(..) )
34import Rel8.Table
35 ( Table, Context, Columns, fromColumns, toColumns
36 , FromExprs, fromResult, toResult
37 )
38import Rel8.Table.Alternative
39 ( AltTable, (<|>:)
40 , AlternativeTable, emptyTable
41 )
42import Rel8.Table.Eq ( EqTable, eqTable )
43import Rel8.Table.Ord ( OrdTable, ordTable )
44import Rel8.Table.Recontextualize ( Recontextualize )
45import Rel8.Table.Serialize ( ToExprs )
48-- | A @ListTable@ value contains zero or more instances of @a@. You construct
49-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
50type ListTable :: K.Context -> Type -> Type
51newtype ListTable context a =
52 ListTable (HListTable (Columns a) (Context a))
55instance (Table context a, context ~ context') =>
56 Table context' (ListTable context a)
57 where
58 type Columns (ListTable context a) = HListTable (Columns a)
59 type Context (ListTable context a) = Context a
60 type FromExprs (ListTable context a) = [FromExprs a]
62 fromColumns = ListTable
63 toColumns (ListTable a) = a
64 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
65 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
68instance (Recontextualize from to a b, from ~ from', to ~ to') =>
69 Recontextualize from to (ListTable from' a) (ListTable to' b)
72instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
73 eqTable =
74 hvectorize
75 (\SSpec {nullity} (Identity Dict) -> case nullity of
76 Null -> Dict
77 NotNull -> Dict)
78 (Identity (eqTable @a))
81instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
82 ordTable =
83 hvectorize
84 (\SSpec {nullity} (Identity Dict) -> case nullity of
85 Null -> Dict
86 NotNull -> Dict)
87 (Identity (ordTable @a))
90instance (ToExprs exprs a, context ~ Expr) =>
91 ToExprs (ListTable context exprs) [a]
94instance context ~ Expr => AltTable (ListTable context) where
95 (<|>:) = (<>)
98instance context ~ Expr => AlternativeTable (ListTable context) where
99 emptyTable = mempty
102instance (context ~ Expr, Table Expr a) =>
103 Semigroup (ListTable context a)
104 where
105 ListTable as <> ListTable bs = ListTable $
106 happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs
109instance (context ~ Expr, Table Expr a) =>
110 Monoid (ListTable context a)
111 where
112 mempty = ListTable $ hempty $ \_ -> E . sempty
115-- | Construct a @ListTable@ from a list of expressions.
116listTable :: Table Expr a => [a] -> ListTable Expr a
117listTable =
118 ListTable .
119 hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
120 fmap toColumns
123-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
124-- have a 'ListTable' that you are storing in a table and need to construct a
125-- 'TableSchema'.
126nameListTable
127 :: Table Name a
128 => a -- ^ The names of the columns of elements of the list.
129 -> ListTable Name a
130nameListTable =
131 ListTable .
132 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
133 pure .
134 toColumns