git.iko.soy/rel8
on bdb75e6 help sign in
rel8/src/Rel8/Table/List.hs
139 lines 3.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, 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( 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.Insert ( Inserts )
30import Rel8.Schema.Name ( Col( N ), Name( Name ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Spec ( SSpec(..) )
33import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
34import Rel8.Schema.Reify ( hreify, hunreify )
35import Rel8.Table
36 ( Table, Context, Columns, fromColumns, toColumns
37 , reify, unreify
38 )
39import Rel8.Table.Alternative
40 ( AltTable, (<|>:)
41 , AlternativeTable, emptyTable
42 )
43import Rel8.Table.Eq ( EqTable, eqTable )
44import Rel8.Table.Insert ( toInsert )
45import Rel8.Table.Ord ( OrdTable, ordTable )
46import Rel8.Table.Recontextualize ( Recontextualize )
47import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
48import Rel8.Table.Unreify ( Unreifies )
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, Unreifies 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 ( Unreifies from a, Unreifies 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 (\_ _ (E a) (E b) -> E (sappend a b)) as bs
118instance Table Expr a => Monoid (ListTable a) where
119 mempty = ListTable $ hempty $ \nullability info ->
120 E (sempty nullability info)
123listTable :: Table Expr a => [a] -> ListTable a
124listTable =
125 ListTable .
126 hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
127 fmap toColumns
130insertListTable :: Inserts exprs inserts => [exprs] -> ListTable inserts
131insertListTable = toInsert . listTable
134nameListTable :: Table Name a => a -> ListTable a
135nameListTable =
136 ListTable .
137 hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
138 pure .
139 toColumns