git.iko.soy/rel8
on c8341c1 help sign in
rel8/src/Rel8/Table/List.hs
115 lines 3.2 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
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(..) )
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.Null ( Nullity( Null, NotNull ) )
30import Rel8.Schema.Spec ( SSpec(..) )
31import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
32import Rel8.Schema.Reify ( hreify, hunreify )
33import Rel8.Table
34 ( Table, Context, Columns, fromColumns, toColumns
35 , reify, unreify
36 )
37import Rel8.Table.Alternative
38 ( AltTable, (<|>:)
39 , AlternativeTable, emptyTable
40 )
41import Rel8.Table.Eq ( EqTable, eqTable )
42import Rel8.Table.Ord ( OrdTable, ordTable )
43import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Table.Unreify ( Unreifiable )
47-- | A @ListTable@ value contains zero or more instances of @a@. You construct
48-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
49type ListTable :: Type -> Type
50newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
53instance (Table context a, Unreifiable context a) =>
54 Table context (ListTable a)
55 where
56 type Columns (ListTable a) = HListTable (Columns a)
57 type Context (ListTable a) = Context a
59 fromColumns = ListTable
60 toColumns (ListTable a) = a
62 reify Refl (ListTable a) = ListTable (hreify a)
63 unreify Refl (ListTable a) = ListTable (hunreify a)
66instance
67 ( Unreifiable from a, Unreifiable to b
68 , Recontextualize from to a b
69 )
70 => Recontextualize from to (ListTable a) (ListTable b)
73instance EqTable a => EqTable (ListTable a) where
74 eqTable =
75 hvectorize
76 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
77 Dict -> case dbTypeNullity dict of
78 Null -> Dict
79 NotNull -> Dict)
80 (Identity (eqTable @a))
83instance OrdTable a => OrdTable (ListTable a) where
84 ordTable =
85 hvectorize
86 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
87 Dict -> case dbTypeNullity dict of
88 Null -> Dict
89 NotNull -> Dict)
90 (Identity (ordTable @a))
93instance AltTable ListTable where
94 (<|>:) = (<>)
97instance AlternativeTable ListTable where
98 emptyTable = mempty
101instance Table Expr a => Semigroup (ListTable a) where
102 ListTable as <> ListTable bs = ListTable $
103 happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs
106instance Table Expr a => Monoid (ListTable a) where
107 mempty = ListTable $ hempty $ \nullability info ->
108 DB (sempty nullability info)
111listTable :: Table Expr a => [a] -> ListTable a
112listTable =
113 ListTable .
114 hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
115 fmap toColumns