git.iko.soy/rel8
on 8a680c9 help sign in
rel8/src/Rel8/Table/List.hs
124 lines 3.5 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.Serialize ( FromExprs, ToExprs, fromResult, toResult )
45import Rel8.Table.Unreify ( Unreifiable )
48-- | A @ListTable@ value contains zero or more instances of @a@. You construct
49-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
50type ListTable :: Type -> Type
51newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
54instance (Table context a, Unreifiable context a) =>
55 Table context (ListTable a)
56 where
57 type Columns (ListTable a) = HListTable (Columns a)
58 type Context (ListTable a) = Context a
60 fromColumns = ListTable
61 toColumns (ListTable a) = a
63 reify Refl (ListTable a) = ListTable (hreify a)
64 unreify Refl (ListTable a) = ListTable (hunreify a)
67instance
68 ( Unreifiable from a, Unreifiable to b
69 , Recontextualize from to a b
70 )
71 => Recontextualize from to (ListTable a) (ListTable b)
74instance EqTable a => EqTable (ListTable a) where
75 eqTable =
76 hvectorize
77 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
78 Dict -> case dbTypeNullity dict of
79 Null -> Dict
80 NotNull -> Dict)
81 (Identity (eqTable @a))
84instance OrdTable a => OrdTable (ListTable a) where
85 ordTable =
86 hvectorize
87 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
88 Dict -> case dbTypeNullity dict of
89 Null -> Dict
90 NotNull -> Dict)
91 (Identity (ordTable @a))
94type instance FromExprs (ListTable a) = [FromExprs a]
97instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where
98 fromResult = fmap (fromResult @exprs) . fromColumns
99 toResult = toColumns . fmap (toResult @exprs)
102instance AltTable ListTable where
103 (<|>:) = (<>)
106instance AlternativeTable ListTable where
107 emptyTable = mempty
110instance Table Expr a => Semigroup (ListTable a) where
111 ListTable as <> ListTable bs = ListTable $
112 happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs
115instance Table Expr a => Monoid (ListTable a) where
116 mempty = ListTable $ hempty $ \nullability info ->
117 DB (sempty nullability info)
120listTable :: Table Expr a => [a] -> ListTable a
121listTable =
122 ListTable .
123 hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
124 fmap toColumns