git.iko.soy/rel8
on master help sign in
Add listTable and nonEmptyTable functions
20ddd83Shane O'Brien
src/Rel8/Expr/Array.hs+13−8
compare with master
unifiedsplit
@@ -1,13 +1,12 @@
1{-# language DataKinds #-}
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
2{-# language FlexibleContexts #-}
3−{-# language ScopedTypeVariables #-}
4−{-# language TypeApplications #-}
5{-# language TypeFamilies #-}
3{-# language TypeFamilies #-}
6
4
7{-# options_ghc -fno-warn-redundant-constraints #-}
5{-# options_ghc -fno-warn-redundant-constraints #-}
8
6
9module Rel8.Expr.Array
7module Rel8.Expr.Array
10 ( listOf, nonEmptyOf
8 ( listOf, nonEmptyOf
9+ , slistOf, snonEmptyOf
11 , sappend, sappend1, sempty
10 , sappend, sappend1, sempty
12 )
11 )
13where
12where
@@ -43,11 +42,17 @@ sempty :: Nullability a -> TypeInformation (Unnullify a) -> Expr [a]
43sempty _ info = fromPrimExpr $ array info []
42sempty _ info = fromPrimExpr $ array info []
44
43
45
44
46−listOf :: forall a. Sql DBType a => [Expr a] -> Expr [a]
45+slistOf :: TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
47−listOf =
48− fromPrimExpr . array (typeInformation @(Unnullify a)) . fmap toPrimExpr
46+slistOf info = fromPrimExpr . array info . fmap toPrimExpr
49
47
50
48
51−nonEmptyOf :: forall a. Sql DBType a => NonEmpty (Expr a) -> Expr (NonEmpty a)
49+snonEmptyOf :: TypeInformation (Unnullify a) -> NonEmpty (Expr a) -> Expr (NonEmpty a)
52−nonEmptyOf =
53− fromPrimExpr . array (typeInformation @(Unnullify a)) . fmap toPrimExpr
50+snonEmptyOf info = fromPrimExpr . array info . fmap toPrimExpr
51+
52+
53+listOf :: Sql DBType a => [Expr a] -> Expr [a]
54+listOf = slistOf typeInformation
55+
56+
57+nonEmptyOf :: Sql DBType a => NonEmpty (Expr a) -> Expr (NonEmpty a)
58+nonEmptyOf = snonEmptyOf typeInformation
src/Rel8/Table/List.hs+11−2
@@ -1,6 +1,7 @@
1{-# language FlexibleContexts #-}
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
2{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
3{-# language MultiParamTypeClasses #-}
4+{-# language NamedFieldPuns #-}
4{-# language ScopedTypeVariables #-}
5{-# language ScopedTypeVariables #-}
5{-# language StandaloneKindSignatures #-}
6{-# language StandaloneKindSignatures #-}
6{-# language TypeApplications #-}
7{-# language TypeApplications #-}
@@ -9,6 +10,7 @@
9
10
10module Rel8.Table.List
11module Rel8.Table.List
11 ( ListTable(..)
12 ( ListTable(..)
13+ , listTable
12 )
14 )
13where
15where
14
16
@@ -19,12 +21,12 @@ import Prelude
19
21
20-- rel8
22-- rel8
21import Rel8.Expr ( Expr, Col(..) )
23import Rel8.Expr ( Expr, Col(..) )
22−import Rel8.Expr.Array ( sappend, sempty )
24+import Rel8.Expr.Array ( sappend, sempty, slistOf )
23import Rel8.Schema.Dict ( Dict( Dict ) )
25import Rel8.Schema.Dict ( Dict( Dict ) )
24import Rel8.Schema.HTable.List ( HListTable )
26import Rel8.Schema.HTable.List ( HListTable )
25import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
27import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
26import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
28import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
27−import Rel8.Schema.Spec ( SSpec( SSpec ) )
29+import Rel8.Schema.Spec ( SSpec(..) )
28import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
30import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
29import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
31import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
30import Rel8.Table.Alternative
32import Rel8.Table.Alternative
@@ -90,3 +92,10 @@ instance Table Expr a => Semigroup (ListTable a) where
90instance Table Expr a => Monoid (ListTable a) where
92instance Table Expr a => Monoid (ListTable a) where
91 mempty = ListTable $ hempty $ \nullability info ->
93 mempty = ListTable $ hempty $ \nullability info ->
92 DB (sempty nullability info)
94 DB (sempty nullability info)
95+
96+
97+listTable :: Table Expr a => [a] -> ListTable a
98+listTable =
99+ ListTable .
100+ hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
101+ fmap toColumns
src/Rel8/Table/NonEmpty.hs+13−2
@@ -1,5 +1,7 @@
1+{-# language FlexibleContexts #-}
1{-# language FlexibleInstances #-}
2{-# language FlexibleInstances #-}
2{-# language MultiParamTypeClasses #-}
3{-# language MultiParamTypeClasses #-}
4+{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
5{-# language ScopedTypeVariables #-}
4{-# language StandaloneKindSignatures #-}
6{-# language StandaloneKindSignatures #-}
5{-# language TypeApplications #-}
7{-# language TypeApplications #-}
@@ -9,22 +11,24 @@
9module Rel8.Table.NonEmpty
11module Rel8.Table.NonEmpty
10 ( NonEmptyTable(..)
12 ( NonEmptyTable(..)
11 , HNonEmptyTable
13 , HNonEmptyTable
14+ , nonEmptyTable
12 )
15 )
13where
16where
14
17
15-- base
18-- base
16import Data.Functor.Identity ( Identity( Identity ) )
19import Data.Functor.Identity ( Identity( Identity ) )
17import Data.Kind ( Type )
20import Data.Kind ( Type )
21+import Data.List.NonEmpty ( NonEmpty )
18import Prelude
22import Prelude
19
23
20-- rel8
24-- rel8
21import Rel8.Expr ( Expr, Col(..) )
25import Rel8.Expr ( Expr, Col(..) )
22−import Rel8.Expr.Array ( sappend1 )
26+import Rel8.Expr.Array ( sappend1, snonEmptyOf )
23import Rel8.Schema.Dict ( Dict( Dict ) )
27import Rel8.Schema.Dict ( Dict( Dict ) )
24import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
28import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
25import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
29import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
26import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
30import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
27−import Rel8.Schema.Spec ( SSpec( SSpec ) )
31+import Rel8.Schema.Spec ( SSpec(..) )
28import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
32import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
29import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
33import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
30import Rel8.Table.Alternative ( AltTable, (<|>:) )
34import Rel8.Table.Alternative ( AltTable, (<|>:) )
@@ -79,3 +83,10 @@ instance AltTable NonEmptyTable where
79instance Table Expr a => Semigroup (NonEmptyTable a) where
83instance Table Expr a => Semigroup (NonEmptyTable a) where
80 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
84 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
81 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
85 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
86+
87+
88+nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
89+nonEmptyTable =
90+ NonEmptyTable .
91+ hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
92+ fmap toColumns