git.iko.soy/rel8
on 0272bcc help sign in
rel8/src/Rel8/Table/List.hs
149 lines 4.2 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 , ($*)
15 , listTable
16 , nameListTable
17 )
18where
20-- base
21import Data.Functor.Identity ( Identity( Identity ) )
22import Data.Kind ( Type )
23import Prelude
25-- rel8
26import Rel8.Expr ( Expr )
27import Rel8.Expr.Array ( sappend, sempty, slistOf )
28import Rel8.Schema.Dict ( Dict( Dict ) )
29import Rel8.Schema.HTable.List ( HListTable )
30import Rel8.Schema.HTable.Vectorize
31 ( hvectorize, hunvectorize
32 , happend, hempty
33 , hproject, hcolumn
34 )
35import qualified Rel8.Schema.Kind as K
36import Rel8.Schema.Name ( Name( Name ) )
37import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
38import Rel8.Schema.Result ( vectorizer, unvectorizer )
39import Rel8.Schema.Spec ( Spec(..) )
40import Rel8.Table
41 ( Table, Context, Columns, fromColumns, toColumns
42 , FromExprs, fromResult, toResult
43 , Transpose
44 )
45import Rel8.Table.Alternative
46 ( AltTable, (<|>:)
47 , AlternativeTable, emptyTable
48 )
49import Rel8.Table.Eq ( EqTable, eqTable )
50import Rel8.Table.Ord ( OrdTable, ordTable )
51import Rel8.Table.Projection
52 ( Projectable, Projecting, Projection, project, apply
53 )
54import Rel8.Table.Serialize ( ToExprs )
57-- | A @ListTable@ value contains zero or more instances of @a@. You construct
58-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
59type ListTable :: K.Context -> Type -> Type
60newtype ListTable context a =
61 ListTable (HListTable (Columns a) (Context a))
64instance Projectable (ListTable context) where
65 project f (ListTable a) = ListTable (hproject (apply f) a)
68instance (Table context a, context ~ context') =>
69 Table context' (ListTable context a)
70 where
71 type Columns (ListTable context a) = HListTable (Columns a)
72 type Context (ListTable context a) = Context a
73 type FromExprs (ListTable context a) = [FromExprs a]
74 type Transpose to (ListTable context a) = ListTable to (Transpose to a)
76 fromColumns = ListTable
77 toColumns (ListTable a) = a
78 fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer
79 toResult = hvectorize vectorizer . fmap (toResult @_ @a)
82instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
83 eqTable =
84 hvectorize
85 (\Spec {nullity} (Identity Dict) -> case nullity of
86 Null -> Dict
87 NotNull -> Dict)
88 (Identity (eqTable @a))
91instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where
92 ordTable =
93 hvectorize
94 (\Spec {nullity} (Identity Dict) -> case nullity of
95 Null -> Dict
96 NotNull -> Dict)
97 (Identity (ordTable @a))
100instance (ToExprs exprs a, context ~ Expr) =>
101 ToExprs (ListTable context exprs) [a]
104instance context ~ Expr => AltTable (ListTable context) where
105 (<|>:) = (<>)
108instance context ~ Expr => AlternativeTable (ListTable context) where
109 emptyTable = mempty
112instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a)
113 where
114 ListTable as <> ListTable bs = ListTable $ happend (const sappend) as bs
117instance (context ~ Expr, Table Expr a) =>
118 Monoid (ListTable context a)
119 where
120 mempty = ListTable $ hempty $ \Spec {info} -> sempty info
123-- | Project a single expression out of a 'ListTable'.
124($*) :: Projecting a (Expr b)
125 => Projection a (Expr b) -> ListTable Expr a -> Expr [b]
126f $* ListTable a = hcolumn $ hproject (apply f) a
127infixl 4 $*
130-- | Construct a @ListTable@ from a list of expressions.
131listTable :: Table Expr a => [a] -> ListTable Expr a
132listTable =
133 ListTable .
134 hvectorize (\Spec {info} -> slistOf info) .
135 fmap toColumns
138-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
139-- have a 'ListTable' that you are storing in a table and need to construct a
140-- 'TableSchema'.
141nameListTable
142 :: Table Name a
143 => a -- ^ The names of the columns of elements of the list.
144 -> ListTable Name a
145nameListTable =
146 ListTable .
147 hvectorize (\_ (Identity (Name a)) -> Name a) .
148 pure .
149 toColumns