git.iko.soy/rel8
on 707a36a help sign in
rel8/src/Rel8/Table/List.hs
146 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 , listTable, nameListTable
15 )
16where
18-- base
19import Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Type )
21import Data.Type.Equality ( (:~:)( Refl ) )
22import Prelude
24-- rel8
25import Rel8.Expr ( Expr, Col( E, unE ) )
26import Rel8.Expr.Array ( sappend, sempty, slistOf )
27import Rel8.Schema.Dict ( Dict( Dict ) )
28import Rel8.Schema.HTable.List ( HListTable )
29import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
30import qualified Rel8.Schema.Kind as K
31import Rel8.Schema.Name ( Col( N ), Name( Name ) )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Spec ( SSpec(..) )
34import Rel8.Schema.Reify ( hreify, hunreify )
35import Rel8.Table
36 ( Table, Context, Columns, fromColumns, toColumns
37 , reify, unreify
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.Recontextualize ( Recontextualize )
46import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
47import Rel8.Table.Unreify ( Unreifies )
50-- | A @ListTable@ value contains zero or more instances of @a@. You construct
51-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
52type ListTable :: K.Context -> Type -> Type
53newtype ListTable context a =
54 ListTable (HListTable (Columns a) (Col (Context a)))
57instance (Table context a, Unreifies context a, context ~ context') =>
58 Table context' (ListTable context a)
59 where
60 type Columns (ListTable context a) = HListTable (Columns a)
61 type Context (ListTable context a) = Context a
63 fromColumns = ListTable
64 toColumns (ListTable a) = a
66 reify Refl (ListTable a) = ListTable (hreify a)
67 unreify Refl (ListTable a) = ListTable (hunreify a)
70instance
71 ( Unreifies from a, from ~ from'
72 , Unreifies to b, to ~ to'
73 , Recontextualize from to a b
74 )
75 => Recontextualize from to (ListTable from' a) (ListTable to' b)
78instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where
79 eqTable =
80 hvectorize
81 (\SSpec {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 (\SSpec {nullity} (Identity Dict) -> case nullity of
91 Null -> Dict
92 NotNull -> Dict)
93 (Identity (ordTable @a))
96type instance FromExprs (ListTable _context a) = [FromExprs a]
99instance (ToExprs exprs a, context ~ Expr) =>
100 ToExprs (ListTable context exprs) [a]
101 where
102 fromResult = fmap (fromResult @exprs) . fromColumns
103 toResult = toColumns . fmap (toResult @exprs)
106instance context ~ Expr => AltTable (ListTable context) where
107 (<|>:) = (<>)
110instance context ~ Expr => AlternativeTable (ListTable context) where
111 emptyTable = mempty
114instance (context ~ Expr, Table Expr a) =>
115 Semigroup (ListTable context a)
116 where
117 ListTable as <> ListTable bs = ListTable $
118 happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs
121instance (context ~ Expr, Table Expr a) =>
122 Monoid (ListTable context a)
123 where
124 mempty = ListTable $ hempty $ \_ -> E . sempty
127-- | Construct a @ListTable@ from a list of expressions.
128listTable :: Table Expr a => [a] -> ListTable Expr a
129listTable =
130 ListTable .
131 hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
132 fmap toColumns
135-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
136-- have a 'ListTable' that you are storing in a table and need to construct a
137-- 'TableSchema'.
138nameListTable
139 :: Table Name a
140 => a -- ^ The names of the columns of elements of the list.
141 -> ListTable Name a
142nameListTable =
143 ListTable .
144 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
145 pure .
146 toColumns