git.iko.soy/rel8
on b0e47ec help sign in
rel8/src/Rel8/Table/List.hs
138 lines 4.0 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 )
25import Rel8.Expr.Array ( sappend, sempty, slistOf )
26import Rel8.Schema.Dict ( Dict( Dict ) )
27import Rel8.Schema.HTable.List ( HListTable )
28import Rel8.Schema.HTable.Vectorize
29 ( hvectorize, hunvectorize
30 , happend, hempty
31 , hproject
32 )
33import qualified Rel8.Schema.Kind as K
34import Rel8.Schema.Name ( Name( Name ) )
35import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
36import Rel8.Schema.Result ( vectorizer, unvectorizer )
37import Rel8.Schema.Spec ( Spec(..) )
38import Rel8.Table
39 ( Table, Context, Columns, fromColumns, toColumns
40 , FromExprs, fromResult, toResult
41 , Transpose
42 )
43import Rel8.Table.Alternative
44 ( AltTable, (<|>:)
45 , AlternativeTable, emptyTable
46 )
47import Rel8.Table.Eq ( EqTable, eqTable )
48import Rel8.Table.Ord ( OrdTable, ordTable )
49import Rel8.Table.Projection ( Projectable, project, apply )
50import Rel8.Table.Serialize ( ToExprs )
53-- | A @ListTable@ value contains zero or more instances of @a@. You construct
54-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
55type ListTable :: K.Context -> Type -> Type
56newtype ListTable context a =
57 ListTable (HListTable (Columns a) (Context a))
60instance Projectable (ListTable context) where
61 project f (ListTable a) = ListTable (hproject (apply f) a)
64instance (Table context a, context ~ context') =>
65 Table context' (ListTable context a)
66 where
67 type Columns (ListTable context a) = HListTable (Columns a)
68 type Context (ListTable context a) = Context a
69 type FromExprs (ListTable context a) = [FromExprs a]
70 type Transpose to (ListTable context a) = ListTable to (Transpose to a)
72 fromColumns = ListTable
73 toColumns (ListTable a) = a
74 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
75 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
78instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
79 eqTable =
80 hvectorize
81 (\Spec {nullity} (Identity Dict) -> case nullity of
82 Null -> Dict
83 NotNull -> Dict)
84 (Identity (eqTable @a))
87instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
88 ordTable =
89 hvectorize
90 (\Spec {nullity} (Identity Dict) -> case nullity of
91 Null -> Dict
92 NotNull -> Dict)
93 (Identity (ordTable @a))
96instance (ToExprs exprs a, context ~ Expr) =>
97 ToExprs (ListTable context exprs) [a]
100instance context ~ Expr => AltTable (ListTable context) where
101 (<|>:) = (<>)
104instance context ~ Expr => AlternativeTable (ListTable context) where
105 emptyTable = mempty
108instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a)
109 where
110 ListTable as <> ListTable bs = ListTable $ happend (const sappend) as bs
113instance (context ~ Expr, Table Expr a) =>
114 Monoid (ListTable context a)
115 where
116 mempty = ListTable $ hempty $ \Spec {info} -> sempty info
119-- | Construct a @ListTable@ from a list of expressions.
120listTable :: Table Expr a => [a] -> ListTable Expr a
121listTable =
122 ListTable .
123 hvectorize (\Spec {info} -> slistOf info) .
124 fmap toColumns
127-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
128-- have a 'ListTable' that you are storing in a table and need to construct a
129-- 'TableSchema'.
130nameListTable
131 :: Table Name a
132 => a -- ^ The names of the columns of elements of the list.
133 -> ListTable Name a
134nameListTable =
135 ListTable .
136 hvectorize (\_ (Identity (Name a)) -> Name a) .
137 pure .
138 toColumns