git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Table/List.hs
101 lines 2.9 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 Prelude
22-- rel8
23import Rel8.Expr ( Expr, Col(..) )
24import Rel8.Expr.Array ( sappend, sempty, slistOf )
25import Rel8.Schema.Dict ( Dict( Dict ) )
26import Rel8.Schema.HTable.List ( HListTable )
27import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
28import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
29import Rel8.Schema.Spec ( SSpec(..) )
30import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
31import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
32import Rel8.Table.Alternative
33 ( AltTable, (<|>:)
34 , AlternativeTable, emptyTable
35 )
36import Rel8.Table.Eq ( EqTable, eqTable )
37import Rel8.Table.Ord ( OrdTable, ordTable )
38import Rel8.Table.Recontextualize ( Recontextualize )
41-- | A @ListTable@ value contains zero or more instances of @a@. You construct
42-- @ListTable@s with 'many' or 'listAgg'.
43type ListTable :: Type -> Type
44newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
47instance Table context a => Table context (ListTable a) where
48 type Columns (ListTable a) = HListTable (Columns a)
49 type Context (ListTable a) = Context a
51 fromColumns = ListTable
52 toColumns (ListTable a) = a
55instance Recontextualize from to a b =>
56 Recontextualize from to (ListTable a) (ListTable b)
59instance EqTable a => EqTable (ListTable a) where
60 eqTable =
61 hvectorize
62 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
63 Dict -> case dbTypeNullability dict of
64 Nullable -> Dict
65 NonNullable -> Dict)
66 (Identity (eqTable @a))
69instance OrdTable a => OrdTable (ListTable a) where
70 ordTable =
71 hvectorize
72 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
73 Dict -> case dbTypeNullability dict of
74 Nullable -> Dict
75 NonNullable -> Dict)
76 (Identity (ordTable @a))
79instance AltTable ListTable where
80 (<|>:) = (<>)
83instance AlternativeTable ListTable where
84 emptyTable = mempty
87instance Table Expr a => Semigroup (ListTable a) where
88 ListTable as <> ListTable bs = ListTable $
89 happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs
92instance Table Expr a => Monoid (ListTable a) where
93 mempty = ListTable $ hempty $ \nullability info ->
94 DB (sempty nullability info)
97listTable :: Table Expr a => [a] -> ListTable a
98listTable =
99 ListTable .
100 hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
101 fmap toColumns