git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Table/List.hs
144 lines 4.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, insertListTable, 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(..) )
25import Rel8.Expr.Array ( sappend, sempty, slistOf )
26import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )
27import Rel8.Schema.Dict ( Dict( Dict ) )
28import Rel8.Schema.HTable.List ( HListTable )
29import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
30import Rel8.Schema.Insert ( Col( OptionalInsert, RequiredInsert ), Insert )
31import Rel8.Schema.Name ( Col( NameCol ), Name )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Spec ( SSpec(..) )
34import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
35import Rel8.Schema.Reify ( hreify, hunreify )
36import Rel8.Table
37 ( Table, Context, Columns, fromColumns, toColumns
38 , reify, unreify
39 )
40import Rel8.Table.Alternative
41 ( AltTable, (<|>:)
42 , AlternativeTable, emptyTable
43 )
44import Rel8.Table.Eq ( EqTable, eqTable )
45import Rel8.Table.Ord ( OrdTable, ordTable )
46import Rel8.Table.Recontextualize ( Recontextualize )
47import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
48import Rel8.Table.Unreify ( Unreifiable )
51-- | A @ListTable@ value contains zero or more instances of @a@. You construct
52-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.
53type ListTable :: Type -> Type
54newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
57instance (Table context a, Unreifiable context a) =>
58 Table context (ListTable a)
59 where
60 type Columns (ListTable a) = HListTable (Columns a)
61 type Context (ListTable 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 ( Unreifiable from a, Unreifiable to b
72 , Recontextualize from to a b
73 )
74 => Recontextualize from to (ListTable a) (ListTable b)
77instance EqTable a => EqTable (ListTable a) where
78 eqTable =
79 hvectorize
80 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
81 Dict -> case dbTypeNullity dict of
82 Null -> Dict
83 NotNull -> Dict)
84 (Identity (eqTable @a))
87instance OrdTable a => OrdTable (ListTable a) where
88 ordTable =
89 hvectorize
90 (\SSpec {} (Identity dict) -> case dbTypeDict dict of
91 Dict -> case dbTypeNullity dict of
92 Null -> Dict
93 NotNull -> Dict)
94 (Identity (ordTable @a))
97type instance FromExprs (ListTable a) = [FromExprs a]
100instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where
101 fromResult = fmap (fromResult @exprs) . fromColumns
102 toResult = toColumns . fmap (toResult @exprs)
105instance AltTable ListTable where
106 (<|>:) = (<>)
109instance AlternativeTable ListTable where
110 emptyTable = mempty
113instance Table Expr a => Semigroup (ListTable a) where
114 ListTable as <> ListTable bs = ListTable $
115 happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs
118instance Table Expr a => Monoid (ListTable a) where
119 mempty = ListTable $ hempty $ \nullability info ->
120 DB (sempty nullability info)
123listTable :: Table Expr a => [a] -> ListTable a
124listTable =
125 ListTable .
126 hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
127 fmap toColumns
130insertListTable :: Table Insert a => [a] -> ListTable a
131insertListTable =
132 ListTable .
133 hvectorize (\SSpec {necessity, info} -> case necessity of
134 SRequired -> RequiredInsert . slistOf info . fmap (\(RequiredInsert a) -> a)
135 SOptional -> OptionalInsert . fmap (slistOf info) . traverse (\(OptionalInsert a) -> a)) .
136 fmap toColumns
139nameListTable :: Table Name a => a -> ListTable a
140nameListTable =
141 ListTable .
142 hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .
143 pure .
144 toColumns