git.iko.soy/rel8
on master help sign in
Add listTable and nonEmptyTable functions
commit20ddd8340d98be0ed088140723134e023eabfd44 authorShane O'Brien <shane.obrien@circuithub.com> dateFri 26 Mar 2021, 20:45 (6 years ago) parent24f0521
3 files changed+37−12
compare with master
unifiedsplit
src/Rel8/Expr/Array.hs+13−8 src/Rel8/Table/List.hs+11−2 src/Rel8/Table/NonEmpty.hs+13−2
src/Rel8/Expr/Array.hs+13−8
@@ -1,13 +1,12 @@
11{-# language DataKinds #-}
22{-# language FlexibleContexts #-}
3−{-# language ScopedTypeVariables #-}
4−{-# language TypeApplications #-}
53{-# language TypeFamilies #-}
64
75{-# options_ghc -fno-warn-redundant-constraints #-}
86
97module Rel8.Expr.Array
108 ( listOf, nonEmptyOf
9+ , slistOf, snonEmptyOf
1110 , sappend, sappend1, sempty
1211 )
1312where
@@ -43,11 +42,17 @@ sempty :: Nullability a -> TypeInformation (Unnullify a) -> Expr [a]
4342sempty _ info = fromPrimExpr $ array info []
4443
4544
46−listOf :: forall a. Sql DBType a => [Expr a] -> Expr [a]
47−listOf =
48− fromPrimExpr . array (typeInformation @(Unnullify a)) . fmap toPrimExpr
45+slistOf :: TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]
46+slistOf info = fromPrimExpr . array info . fmap toPrimExpr
4947
5048
51−nonEmptyOf :: forall a. Sql DBType a => NonEmpty (Expr a) -> Expr (NonEmpty a)
52−nonEmptyOf =
53− fromPrimExpr . array (typeInformation @(Unnullify a)) . fmap toPrimExpr
49+snonEmptyOf :: TypeInformation (Unnullify a) -> NonEmpty (Expr a) -> Expr (NonEmpty a)
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 @@
11{-# language FlexibleContexts #-}
22{-# language FlexibleInstances #-}
33{-# language MultiParamTypeClasses #-}
4+{-# language NamedFieldPuns #-}
45{-# language ScopedTypeVariables #-}
56{-# language StandaloneKindSignatures #-}
67{-# language TypeApplications #-}
@@ -9,6 +10,7 @@
910
1011module Rel8.Table.List
1112 ( ListTable(..)
13+ , listTable
1214 )
1315where
1416
@@ -19,12 +21,12 @@ import Prelude
1921
2022-- rel8
2123import Rel8.Expr ( Expr, Col(..) )
22−import Rel8.Expr.Array ( sappend, sempty )
24+import Rel8.Expr.Array ( sappend, sempty, slistOf )
2325import Rel8.Schema.Dict ( Dict( Dict ) )
2426import Rel8.Schema.HTable.List ( HListTable )
2527import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
2628import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
27−import Rel8.Schema.Spec ( SSpec( SSpec ) )
29+import Rel8.Schema.Spec ( SSpec(..) )
2830import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
2931import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
3032import Rel8.Table.Alternative
@@ -90,3 +92,10 @@ instance Table Expr a => Semigroup (ListTable a) where
9092instance Table Expr a => Monoid (ListTable a) where
9193 mempty = ListTable $ hempty $ \nullability info ->
9294 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 #-}
12{-# language FlexibleInstances #-}
23{-# language MultiParamTypeClasses #-}
4+{-# language NamedFieldPuns #-}
35{-# language ScopedTypeVariables #-}
46{-# language StandaloneKindSignatures #-}
57{-# language TypeApplications #-}
@@ -9,22 +11,24 @@
911module Rel8.Table.NonEmpty
1012 ( NonEmptyTable(..)
1113 , HNonEmptyTable
14+ , nonEmptyTable
1215 )
1316where
1417
1518-- base
1619import Data.Functor.Identity ( Identity( Identity ) )
1720import Data.Kind ( Type )
21+import Data.List.NonEmpty ( NonEmpty )
1822import Prelude
1923
2024-- rel8
2125import Rel8.Expr ( Expr, Col(..) )
22−import Rel8.Expr.Array ( sappend1 )
26+import Rel8.Expr.Array ( sappend1, snonEmptyOf )
2327import Rel8.Schema.Dict ( Dict( Dict ) )
2428import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
2529import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
2630import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
27−import Rel8.Schema.Spec ( SSpec( SSpec ) )
31+import Rel8.Schema.Spec ( SSpec(..) )
2832import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
2933import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
3034import Rel8.Table.Alternative ( AltTable, (<|>:) )
@@ -79,3 +83,10 @@ instance AltTable NonEmptyTable where
7983instance Table Expr a => Semigroup (NonEmptyTable a) where
8084 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
8185 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