git.iko.soy/rel8
on f47423e help sign in
rel8/src/Rel8/Table/List.hs
129 lines 3.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 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 ( happend, hempty, hvectorize, hunvectorize )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.Name ( Name( Name ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Result ( vectorizer, unvectorizer )
33import Rel8.Schema.Spec ( Spec(..) )
34import Rel8.Table
35 ( Table, Context, Columns, fromColumns, toColumns
36 , FromExprs, fromResult, toResult
37 , Transpose
38 )
39import Rel8.Table.Alternative
40 ( AltTable, (<|>:)
41 , AlternativeTable, emptyTable
42 )
43import Rel8.Table.Eq ( EqTable, eqTable )
44import Rel8.Table.Ord ( OrdTable, ordTable )
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]
61 type Transpose to (ListTable context a) = ListTable to (Transpose to a)
63 fromColumns = ListTable
64 toColumns (ListTable a) = a
65 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
66 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
69instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
70 eqTable =
71 hvectorize
72 (\Spec {nullity} (Identity Dict) -> case nullity of
73 Null -> Dict
74 NotNull -> Dict)
75 (Identity (eqTable @a))
78instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
79 ordTable =
80 hvectorize
81 (\Spec {nullity} (Identity Dict) -> case nullity of
82 Null -> Dict
83 NotNull -> Dict)
84 (Identity (ordTable @a))
87instance (ToExprs exprs a, context ~ Expr) =>
88 ToExprs (ListTable context exprs) [a]
91instance context ~ Expr => AltTable (ListTable context) where
92 (<|>:) = (<>)
95instance context ~ Expr => AlternativeTable (ListTable context) where
96 emptyTable = mempty
99instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a)
100 where
101 ListTable as <> ListTable bs = ListTable $ happend (const sappend) as bs
104instance (context ~ Expr, Table Expr a) =>
105 Monoid (ListTable context a)
106 where
107 mempty = ListTable $ hempty $ \Spec {info} -> sempty info
110-- | Construct a @ListTable@ from a list of expressions.
111listTable :: Table Expr a => [a] -> ListTable Expr a
112listTable =
113 ListTable .
114 hvectorize (\Spec {info} -> slistOf info) .
115 fmap toColumns
118-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
119-- have a 'ListTable' that you are storing in a table and need to construct a
120-- 'TableSchema'.
121nameListTable
122 :: Table Name a
123 => a -- ^ The names of the columns of elements of the list.
124 -> ListTable Name a
125nameListTable =
126 ListTable .
127 hvectorize (\_ (Identity (Name a)) -> Name a) .
128 pure .
129 toColumns