git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Table/List.hs
139 lines 4.0 kB history raw
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
4{-# language NamedFieldPuns #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Table.List
12 ( ListTable(..)
13 , listTable, nameListTable
14 )
15where
17-- base
18import Data.Functor.Identity ( Identity( Identity ) )
19import Data.Kind ( Type )
20import Data.Type.Equality ( (:~:)( Refl ) )
21import Prelude
23-- rel8
24import Rel8.Expr ( Expr, Col( 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 )
29import Rel8.Schema.Name ( Col( N ), Name( Name ) )
30import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
31import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
33import Rel8.Schema.Reify ( hreify, hunreify )
34import Rel8.Table
35 ( Table, Context, Columns, fromColumns, toColumns
36 , reify, unreify
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 ( FromExprs, ToExprs, fromResult, toResult )
46import Rel8.Table.Unreify ( Unreifies )
49-- | A @ListTable@ value contains zero or more instances of @a@. You construct
50-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
51type ListTable :: Type -> Type
52newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
55instance (Table context a, Unreifies context a) =>
56 Table context (ListTable a)
57 where
58 type Columns (ListTable a) = HListTable (Columns a)
59 type Context (ListTable a) = Context a
61 fromColumns = ListTable
62 toColumns (ListTable a) = a
64 reify Refl (ListTable a) = ListTable (hreify a)
65 unreify Refl (ListTable a) = ListTable (hunreify a)
68instance
69 ( Unreifies from a, Unreifies to b
70 , Recontextualize from to a b
71 )
72 => Recontextualize from to (ListTable a) (ListTable b)
75instance EqTable a => EqTable (ListTable a) where
76 eqTable =
77 hvectorize
78 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
79 Dict -> case dbTypeNullity dict of
80 Null -> Dict
81 NotNull -> Dict)
82 (Identity (eqTable @a))
85instance OrdTable a => OrdTable (ListTable a) where
86 ordTable =
87 hvectorize
88 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
89 Dict -> case dbTypeNullity dict of
90 Null -> Dict
91 NotNull -> Dict)
92 (Identity (ordTable @a))
95type instance FromExprs (ListTable a) = [FromExprs a]
98instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where
99 fromResult = fmap (fromResult @exprs) . fromColumns
100 toResult = toColumns . fmap (toResult @exprs)
103instance AltTable ListTable where
104 (<|>:) = (<>)
107instance AlternativeTable ListTable where
108 emptyTable = mempty
111instance Table Expr a => Semigroup (ListTable a) where
112 ListTable as <> ListTable bs = ListTable $
113 happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs
116instance Table Expr a => Monoid (ListTable a) where
117 mempty = ListTable $ hempty $ \_ -> E . sempty
120-- | Construct a @ListTable@ from a list of expressions.
121listTable :: Table Expr a => [a] -> ListTable a
122listTable =
123 ListTable .
124 hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
125 fmap toColumns
128-- | Construct a 'ListTable' in the 'Name' context. This can be useful if you
129-- have a 'ListTable' that you are storing in a table and need to construct a
130-- 'TableSchema'.
131nameListTable
132 :: Table Name a
133 => a -- ^ The names of the columns of elements of the list.
134 -> ListTable a
135nameListTable =
136 ListTable .
137 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
138 pure .
139 toColumns