git.iko.soy/rel8
on master help sign in
Simplify Spec to just labels, necessity and type
commit53616d0a40999714936bc78e30b7eb1c8d232845 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 25 Mar 2021, 01:36 (6 years ago) parentdec2074
38 files changed+308−340
compare with master
unifiedsplit
src/Rel8.hs+1−1 src/Rel8/Aggregate.hs+1−1 src/Rel8/Expr.hs+1−3 src/Rel8/Expr/Aggregate.hs+2−7 src/Rel8/Expr/Array.hs+1−1 src/Rel8/Expr/Eq.hs+23−34 src/Rel8/Expr/Null.hs+4−5 src/Rel8/Expr/Opaleye.hs+6−6 src/Rel8/Expr/Ord.hs+17−34 src/Rel8/Expr/Serialize.hs+7−6 src/Rel8/Schema/Column.hs−2 src/Rel8/Schema/Context.hs+1−1 src/Rel8/Schema/Context/Identity.hs+17−16 src/Rel8/Schema/Context/Label.hs+8−8 src/Rel8/Schema/Context/Nullify.hs+15−11 src/Rel8/Schema/Field.hs+9−9 src/Rel8/Schema/Generic.hs+24−24 src/Rel8/Schema/HTable/Either.hs+1−1 src/Rel8/Schema/HTable/Label.hs+7−7 src/Rel8/Schema/HTable/Maybe.hs+1−1 src/Rel8/Schema/HTable/Nullify.hs+13−12 src/Rel8/Schema/HTable/These.hs+2−2 src/Rel8/Schema/HTable/Type.hs+4−4 src/Rel8/Schema/HTable/Vectorize.hs+27−23 src/Rel8/Schema/Insert.hs+2−2 src/Rel8/Schema/Name.hs+2−2 src/Rel8/Schema/Nullability.hs+20−22 src/Rel8/Schema/Spec.hs+6−7 src/Rel8/Schema/Spec/ConstrainDBType.hs+6−5 src/Rel8/Schema/Spec/ConstrainType.hs+3−3 src/Rel8/Table/Aggregate.hs+4−6 src/Rel8/Table/Eq.hs+5−14 src/Rel8/Table/Opaleye.hs+9−10 src/Rel8/Table/Ord.hs+7−24 src/Rel8/Table/Order.hs+40−14 src/Rel8/Table/Undefined.hs+2−2 src/Rel8/Type/Array.hs+7−7 src/Rel8/Type/Array1D.hs+3−3
src/Rel8.hs+1−1
@@ -233,7 +233,7 @@ module Rel8
233233 -- TODO
234234 -- These need organizing, but are reachable from Rel8's documentation so we
235235 -- do need to export and document them.
236− , Nullabilizes
236+ , HasNullability
237237 , HTable
238238 , Labelable
239239 , Context
src/Rel8/Aggregate.hs+1−1
@@ -70,7 +70,7 @@ instance Interpretation Aggregate where
7070 data Col Aggregate _spec where
7171 Aggregation :: ()
7272 => Aggregate (Expr a)
73− -> Col Aggregate ('Spec labels necessity db a)
73+ -> Col Aggregate ('Spec labels necessity a)
7474
7575
7676instance Table Expr a => Table Aggregate (Aggregate a) where
src/Rel8/Expr.hs+1−3
@@ -108,9 +108,7 @@ instance Sql DBFractional a => Fractional (Expr a) where
108108
109109instance Interpretation Expr where
110110 data Col Expr _spec where
111− DB :: ()
112− => { unDB :: Expr a }
113− -> Col Expr ('Spec labels necessity db a)
111+ DB :: {unDB :: Expr a} -> Col Expr ('Spec labels necessity a)
114112
115113
116114instance Sql DBType a => Table Expr (Expr a) where
src/Rel8/Expr/Aggregate.hs+2−7
@@ -14,7 +14,6 @@ module Rel8.Expr.Aggregate
1414 , stringAgg
1515 , groupByExpr
1616 , listAggExpr, nonEmptyAggExpr
17− , sgroupByExpr
1817 )
1918where
2019
@@ -38,7 +37,7 @@ import Rel8.Expr.Opaleye
3837 )
3938import Rel8.Expr.Null ( null )
4039import Rel8.Expr.Serialize ( litExpr )
41−import Rel8.Schema.Nullability ( Nullability, Sql, nullabilization )
40+import Rel8.Schema.Nullability ( Sql )
4241import Rel8.Type.Array ( fromPrimArray )
4342import Rel8.Type.Eq ( DBEq )
4443import Rel8.Type.Num ( DBNum )
@@ -150,7 +149,7 @@ stringAgg delimiter =
150149
151150-- | Aggregate a value by grouping by it.
152151groupByExpr :: Sql DBEq a => Expr a -> Aggregate (Expr a)
153−groupByExpr = sgroupByExpr nullabilization
152+groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing
154153
155154
156155listAggExpr :: Expr a -> Aggregate (Expr [a])
@@ -173,7 +172,3 @@ nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
173172 }
174173 where
175174 from = fromPrimExpr . fromPrimArray
176−
177−
178−sgroupByExpr :: DBEq db => Nullability db a -> Expr a -> Aggregate (Expr a)
179−sgroupByExpr _ = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing
src/Rel8/Expr/Array.hs+1−1
@@ -39,7 +39,7 @@ sappend1 :: Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)
3939sappend1 = zipPrimExprsWith (zipPrimArraysWith (Opaleye.BinExpr (Opaleye.:||)))
4040
4141
42−sempty :: Nullability t a -> TypeInformation t -> Expr [a]
42+sempty :: Nullability a -> TypeInformation (Unnullify a) -> Expr [a]
4343sempty _ info = fromPrimExpr $ array info []
4444
4545
src/Rel8/Expr/Eq.hs+23−34
@@ -1,13 +1,14 @@
11{-# language FlexibleContexts #-}
22{-# language GADTs #-}
33{-# language LambdaCase #-}
4+{-# language ScopedTypeVariables #-}
5+{-# language TypeApplications #-}
46{-# language ViewPatterns #-}
57
68{-# options_ghc -fno-warn-redundant-constraints #-}
79
810module Rel8.Expr.Eq
9− ( seq, sne
10− , (==.), (/=.)
11+ ( (==.), (/=.)
1112 , (==?), (/=?)
1213 , in_
1314 )
@@ -16,7 +17,7 @@ where
1617-- base
1718import Data.Foldable ( toList )
1819import Data.List.NonEmpty ( nonEmpty )
19−import Prelude hiding ( seq, sin )
20+import Prelude
2021
2122-- opaleye
2223import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
@@ -41,39 +42,16 @@ ne :: DBEq a => Expr a -> Expr a -> Expr Bool
4142ne = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<>))
4243
4344
44−seq :: DBEq db => Nullability db a -> Expr a -> Expr a -> Expr Bool
45−seq = \case
46− Nullable -> \ma mb -> isNull ma &&. isNull mb ||. ma ==? mb
47− NonNullable -> eq
48−
49−
50−sne :: DBEq db => Nullability db a -> Expr a -> Expr a -> Expr Bool
51−sne = \case
52− Nullable -> \ma mb -> isNull ma `ne` isNull mb ||. ma /=? mb
53− NonNullable -> ne
54−
55−
56−sin :: (DBEq db, Foldable f)
57− => Nullability db a -> Expr a -> f (Expr a) -> Expr Bool
58−sin nullability a (toList -> as) = case nullability of
59− Nullable -> or_ $ map (seq Nullable a) as
60− NonNullable -> case nonEmpty as of
61− Nothing -> false
62− Just xs ->
63− fromPrimExpr $
64− Opaleye.BinExpr Opaleye.OpIn
65− (toPrimExpr a)
66− (Opaleye.ListExpr (toPrimExpr <$> xs))
67−
68−
6945-- | Compare two expressions for equality.
7046--
7147-- This corresponds to the SQL @IS NOT DISTINCT FROM@ operator, and will equate
7248-- @null@ values as @true@. This differs from @=@ which would return @null@.
7349-- This operator matches Haskell's '==' operator. For an operator identical to
7450-- SQL @=@, see '==?'.
75−(==.) :: Sql DBEq a => Expr a -> Expr a -> Expr Bool
76−(==.) = seq nullabilization
51+(==.) :: forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
52+(==.) = case nullabilization @a of
53+ Nullable -> \ma mb -> isNull ma &&. isNull mb ||. ma ==? mb
54+ NonNullable -> eq
7755infix 4 ==.
7856
7957
@@ -83,8 +61,10 @@ infix 4 ==.
8361-- @false@ when comparing two @null@ values. This differs from ordinary @=@
8462-- which would return @null@. This operator is closer to Haskell's '=='
8563-- operator. For an operator identical to SQL @=@, see '/=?'.
86−(/=.) :: Sql DBEq a => Expr a -> Expr a -> Expr Bool
87−(/=.) = sne nullabilization
64+(/=.) :: forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
65+(/=.) = case nullabilization @a of
66+ Nullable -> \ma mb -> isNull ma `ne` isNull mb ||. ma /=? mb
67+ NonNullable -> ne
8868infix 4 /=.
8969
9070
@@ -128,5 +108,14 @@ infix 4 /=?
128108--
129109-- >>> select c $ return $ lit (42 :: Int32) `in_` [ lit x | x <- [1..5] ]
130110-- [False]
131−in_ :: (Sql DBEq a, Foldable f) => Expr a -> f (Expr a) -> Expr Bool
132−in_ = sin nullabilization
111+in_ :: forall a f. (Sql DBEq a, Foldable f)
112+ => Expr a -> f (Expr a) -> Expr Bool
113+in_ a (toList -> as) = case nullabilization @a of
114+ Nullable -> or_ $ map (a ==.) as
115+ NonNullable -> case nonEmpty as of
116+ Nothing -> false
117+ Just xs ->
118+ fromPrimExpr $
119+ Opaleye.BinExpr Opaleye.OpIn
120+ (toPrimExpr a)
121+ (Opaleye.ListExpr (toPrimExpr <$> xs))
src/Rel8/Expr/Null.hs+4−5
@@ -23,7 +23,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2323import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
2424import Rel8.Expr.Bool ( (||.), boolExpr )
2525import Rel8.Expr.Opaleye ( scastExpr, mapPrimExpr )
26−import Rel8.Schema.Nullability ( Nullability( Nullable ), IsMaybe )
26+import Rel8.Schema.Nullability ( IsMaybe )
2727import Rel8.Type ( DBType, typeInformation )
2828import Rel8.Type.Information ( TypeInformation )
2929
@@ -93,14 +93,13 @@ liftOpNullable f ma mb =
9393 (isNull ma ||. isNull mb)
9494
9595
96−snull :: Nullability a (Maybe a) -> TypeInformation a -> Expr (Maybe a)
97−snull nullability info =
98− scastExpr nullability info $ Expr $ Opaleye.ConstExpr Opaleye.NullLit
96+snull :: TypeInformation a -> Expr (Maybe a)
97+snull info = scastExpr info $ Expr $ Opaleye.ConstExpr Opaleye.NullLit
9998
10099
101100-- | Corresponds to SQL @null@.
102101null :: (IsMaybe a ~ 'False, DBType a) => Expr (Maybe a)
103−null = snull Nullable typeInformation
102+null = snull typeInformation
104103
105104
106105unsafeMapNullable :: IsMaybe b ~ 'False
src/Rel8/Expr/Opaleye.hs+6−6
@@ -25,26 +25,26 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2525
2626-- rel8
2727import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
28−import Rel8.Schema.Nullability ( Nullability, Sql, nullabilization )
28+import Rel8.Schema.Nullability ( Unnullify, Sql )
2929import Rel8.Type ( DBType, typeInformation )
3030import Rel8.Type.Information ( TypeInformation(..) )
3131
3232
3333castExpr :: Sql DBType a => Expr a -> Expr a
34−castExpr = scastExpr nullabilization typeInformation
34+castExpr = scastExpr typeInformation
3535
3636
3737unsafeCastExpr :: Sql DBType b => Expr a -> Expr b
38−unsafeCastExpr = sunsafeCastExpr nullabilization typeInformation
38+unsafeCastExpr = sunsafeCastExpr typeInformation
3939
4040
41−scastExpr :: Nullability db a -> TypeInformation db -> Expr a -> Expr a
41+scastExpr :: TypeInformation (Unnullify a) -> Expr a -> Expr a
4242scastExpr = sunsafeCastExpr
4343
4444
4545sunsafeCastExpr :: ()
46− => Nullability db b -> TypeInformation db -> Expr a -> Expr b
47−sunsafeCastExpr _ TypeInformation {typeName} =
46+ => TypeInformation (Unnullify b) -> Expr a -> Expr b
47+sunsafeCastExpr TypeInformation {typeName} =
4848 fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr
4949
5050
src/Rel8/Expr/Ord.hs+17−34
@@ -8,8 +8,7 @@
88{-# options_ghc -fno-warn-redundant-constraints #-}
99
1010module Rel8.Expr.Ord
11− ( slt, sle, sgt, sge
12− , (<.), (<=.), (>.), (>=.)
11+ ( (<.), (<=.), (>.), (>=.)
1312 , (<?), (<=?), (>?), (>=?)
1413 , leastExpr, greatestExpr
1514 )
@@ -49,59 +48,43 @@ ge :: DBOrd a => Expr a -> Expr a -> Expr Bool
4948ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))
5049
5150
52−slt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
53−slt = \case
54− Nullable -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb
55− NonNullable -> lt
56−
57−
58−sle :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
59−sle = \case
60− Nullable -> \ma mb -> isNull ma ||. ma <=? mb
61− NonNullable -> le
62−
63−
64−sgt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
65−sgt = \case
66− Nullable -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb
67− NonNullable -> gt
68−
69−
70−sge :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
71−sge = \case
72− Nullable -> \ma mb -> isNull mb ||. ma >=? mb
73− NonNullable -> ge
74−
75−
7651-- | Corresponds to the SQL @<@ operator. Note that this differs from SQL @<@
7752-- as @null@ will sort below any other value. For a version of @<@ that exactly
7853-- matches SQL, see '(<?)'.
79−(<.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
80−(<.) = slt nullabilization
54+(<.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool
55+(<.) = case nullabilization @a of
56+ Nullable -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb
57+ NonNullable -> lt
8158infix 4 <.
8259
8360
8461-- | Corresponds to the SQL @<=@ operator. Note that this differs from SQL @<=@
8562-- as @null@ will sort below any other value. For a version of @<=@ that exactly
8663-- matches SQL, see '(<=?)'.
87−(<=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
88−(<=.) = sle nullabilization
64+(<=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool
65+(<=.) = case nullabilization @a of
66+ Nullable -> \ma mb -> isNull ma ||. ma <=? mb
67+ NonNullable -> le
8968infix 4 <=.
9069
9170
9271-- | Corresponds to the SQL @>@ operator. Note that this differs from SQL @>@
9372-- as @null@ will sort below any other value. For a version of @>@ that exactly
9473-- matches SQL, see '(>?)'.
95−(>.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
96−(>.) = sgt nullabilization
74+(>.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool
75+(>.) = case nullabilization @a of
76+ Nullable -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb
77+ NonNullable -> gt
9778infix 4 >.
9879
9980
10081-- | Corresponds to the SQL @>=@ operator. Note that this differs from SQL @>@
10182-- as @null@ will sort below any other value. For a version of @>=@ that
10283-- exactly matches SQL, see '(>=?)'.
103−(>=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
104−(>=.) = sge nullabilization
84+(>=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool
85+(>=.) = case nullabilization @a of
86+ Nullable -> \ma mb -> isNull mb ||. ma >=? mb
87+ NonNullable -> ge
10588infix 4 >=.
10689
10790
src/Rel8/Expr/Serialize.hs+7−6
@@ -22,7 +22,8 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2222import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
2323import Rel8.Expr.Opaleye ( scastExpr )
2424import Rel8.Schema.Nullability
25− ( Nullability( Nullable, NonNullable )
25+ ( Unnullify
26+ , Nullability( Nullable, NonNullable )
2627 , Sql, nullabilization
2728 )
2829import Rel8.Type ( DBType, typeInformation )
@@ -33,16 +34,16 @@ litExpr :: Sql DBType a => a -> Expr a
3334litExpr = slitExpr nullabilization typeInformation
3435
3536
36−slitExpr :: Nullability db a -> TypeInformation db -> a -> Expr a
37−slitExpr nullable info@TypeInformation {encode} =
38− scastExpr nullable info . Expr . encoder
37+slitExpr :: Nullability a -> TypeInformation (Unnullify a) -> a -> Expr a
38+slitExpr nullability info@TypeInformation {encode} =
39+ scastExpr info . Expr . encoder
3940 where
40− encoder = case nullable of
41+ encoder = case nullability of
4142 Nullable -> maybe (Opaleye.ConstExpr Opaleye.NullLit) encode
4243 NonNullable -> encode
4344
4445
45−sparseValue :: Nullability db a -> TypeInformation db -> Hasql.Row a
46+sparseValue :: Nullability a -> TypeInformation (Unnullify a) -> Hasql.Row a
4647sparseValue nullability TypeInformation {decode, out} = case nullability of
4748 Nullable -> Hasql.column $ Hasql.nullable $ out <$> decode
4849 NonNullable -> Hasql.column $ Hasql.nonNullable $ out <$> decode
src/Rel8/Schema/Column.hs−2
@@ -28,7 +28,6 @@ import Rel8.Schema.Field ( Field )
2828import Rel8.Schema.Insert ( Insert )
2929import qualified Rel8.Schema.Kind as K
3030import Rel8.Schema.Name ( Name )
31−import Rel8.Schema.Nullability ( Unnullify )
3231import Rel8.Schema.Structure
3332 ( Structure
3433 , Shape( Either, List, Maybe, NonEmpty, These )
@@ -111,7 +110,6 @@ type Column :: K.Context -> Type -> Type
111110type Column context a =
112111 Field context (GetLabel a)
113112 (GetNecessity (UnwrapLabel a))
114− (Unnullify (UnwrapDefault (UnwrapLabel a)))
115113 (UnwrapDefault (UnwrapLabel a))
116114
117115
src/Rel8/Schema/Context.hs+1−1
@@ -25,4 +25,4 @@ class Interpretation context where
2525
2626instance Interpretation Identity where
2727 data Col Identity _spec where
28− Result :: a -> Col Identity ('Spec labels necessity db a)
28+ Result :: a -> Col Identity ('Spec labels necessity a)
src/Rel8/Schema/Context/Identity.hs+17−16
@@ -30,7 +30,8 @@ import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
3030import Rel8.Schema.HTable.These ( HTheseTable(..) )
3131import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
3232import Rel8.Schema.Nullability
33− ( Nullability( Nullable, NonNullable )
33+ ( Nullify
34+ , Nullability( Nullable, NonNullable )
3435 )
3536import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
3637import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), MaybeTag( IsJust ) )
@@ -155,23 +156,23 @@ fromHTheseTable HTheseTable {hhereTag, hhere, hthereTag, hthere} =
155156{-# INLINABLE fromHTheseTable #-}
156157
157158
158−null :: Col Identity ('Spec labels necessity db (Maybe db))
159+null :: Col Identity ('Spec labels necessity (Maybe a))
159160null = Result Nothing
160161
161162
162163nullifier :: ()
163− => SSpec ('Spec labels necessity db a)
164− -> Col Identity ('Spec labels necessity db a)
165− -> Col Identity ('Spec labels necessity db (Maybe db))
164+ => SSpec ('Spec labels necessity a)
165+ -> Col Identity ('Spec labels necessity a)
166+ -> Col Identity ('Spec labels necessity (Nullify a))
166167nullifier SSpec {nullability} (Result a) = Result $ case nullability of
167168 Nullable -> a
168169 NonNullable -> Just a
169170
170171
171172unnullifier :: ()
172− => SSpec ('Spec labels necessity db a)
173− -> Col Identity ('Spec labels necessity db (Maybe db))
174− -> Maybe (Col Identity ('Spec labels necessity db a))
173+ => SSpec ('Spec labels necessity a)
174+ -> Col Identity ('Spec labels necessity (Nullify a))
175+ -> Maybe (Col Identity ('Spec labels necessity a))
175176unnullifier SSpec {nullability} (Result a) =
176177 case nullability of
177178 Nullable -> pure $ Result a
@@ -179,20 +180,20 @@ unnullifier SSpec {nullability} (Result a) =
179180
180181
181182vectorizer :: Functor f
182− => SSpec ('Spec labels necessity db a)
183− -> f (Col Identity ('Spec labels necessity db a))
184− -> Col Identity ('Spec labels necessity (f a) (f a))
183+ => SSpec ('Spec labels necessity a)
184+ -> f (Col Identity ('Spec labels necessity a))
185+ -> Col Identity ('Spec labels necessity (f a))
185186vectorizer _ = Result . fmap (\(Result a) -> a)
186187
187188
188189unvectorizer :: Functor f
189− => SSpec ('Spec labels necessity db a)
190− -> Col Identity ('Spec labels necessity (f a) (f a))
191− -> f (Col Identity ('Spec labels necessity db a))
190+ => SSpec ('Spec labels necessity a)
191+ -> Col Identity ('Spec labels necessity (f a))
192+ -> f (Col Identity ('Spec labels necessity a))
192193unvectorizer _ (Result results) = Result <$> results
193194
194195
195196relabel :: ()
196− => HIdentity ('Spec labels necessity db a) (Col Identity)
197− -> HIdentity ('Spec relabels necessity db a) (Col Identity)
197+ => HIdentity ('Spec labels necessity a) (Col Identity)
198+ -> HIdentity ('Spec relabels necessity a) (Col Identity)
198199relabel (HIdentity (Result a)) = HIdentity (Result a)
src/Rel8/Schema/Context/Label.hs+8−8
@@ -23,12 +23,12 @@ import Rel8.Schema.Spec ( Spec( Spec ) )
2323type Labelable :: Context -> Constraint
2424class Interpretation context => Labelable context where
2525 labeler :: ()
26− => Col context ('Spec labels necessity db a)
27− -> Col context ('Spec (label ': labels) necessity db a)
26+ => Col context ('Spec labels necessity a)
27+ -> Col context ('Spec (label ': labels) necessity a)
2828
2929 unlabeler :: ()
30− => Col context ('Spec (label ': labels) necessity db a)
31− -> Col context ('Spec labels necessity db a)
30+ => Col context ('Spec (label ': labels) necessity a)
31+ -> Col context ('Spec labels necessity a)
3232
3333
3434instance Labelable Identity where
@@ -39,12 +39,12 @@ instance Labelable Identity where
3939type HLabelable :: HContext -> Constraint
4040class HLabelable context where
4141 hlabeler :: ()
42− => context ('Spec labels necessity db a)
43− -> context ('Spec (label ': labels) necessity db a)
42+ => context ('Spec labels necessity a)
43+ -> context ('Spec (label ': labels) necessity a)
4444
4545 hunlabeler :: ()
46− => context ('Spec (label ': labels) necessity db a)
47− -> context ('Spec labels necessity db a)
46+ => context ('Spec (label ': labels) necessity a)
47+ -> context ('Spec labels necessity a)
4848
4949
5050instance Labelable context => HLabelable (Col context) where
src/Rel8/Schema/Context/Nullify.hs+15−11
@@ -28,7 +28,11 @@ import Rel8.Kind.Labels ( KnownLabels )
2828import Rel8.Kind.Necessity ( Necessity( Required ) )
2929import Rel8.Schema.Context ( Interpretation, Col(..) )
3030import qualified Rel8.Schema.Kind as K
31−import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ), Sql )
31+import Rel8.Schema.Nullability
32+ ( Nullify
33+ , Nullability( Nullable, NonNullable )
34+ , Sql
35+ )
3236import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
3337import Rel8.Type.Eq ( DBEq )
3438import Rel8.Type.Monoid ( DBMonoid )
@@ -38,23 +42,23 @@ type Nullifiable :: K.Context -> Constraint
3842class Interpretation context => Nullifiable context where
3943 encodeTag :: (Sql DBEq a, KnownLabels labels)
4044 => Expr a
41− -> Col context ('Spec labels 'Required db a)
45+ -> Col context ('Spec labels 'Required a)
4246
4347 decodeTag :: Sql DBMonoid a
44− => Col context ('Spec labels 'Required db a)
48+ => Col context ('Spec labels 'Required a)
4549 -> Expr a
4650
4751 nullifier :: ()
4852 => Expr Bool
49− -> SSpec ('Spec labels necessity db a)
50− -> Col context ('Spec labels necessity db a)
51− -> Col context ('Spec labels necessity db (Maybe db))
53+ -> SSpec ('Spec labels necessity a)
54+ -> Col context ('Spec labels necessity a)
55+ -> Col context ('Spec labels necessity (Nullify a))
5256
5357 unnullifier :: ()
5458 => Expr Bool
55− -> SSpec ('Spec labels necessity db a)
56− -> Col context ('Spec labels necessity db (Maybe db))
57− -> Col context ('Spec labels necessity db a)
59+ -> SSpec ('Spec labels necessity a)
60+ -> Col context ('Spec labels necessity (Nullify a))
61+ -> Col context ('Spec labels necessity a)
5862
5963
6064type NullifiableEq :: K.Context -> K.Context -> Constraint
@@ -62,7 +66,7 @@ class (a ~ b, Nullifiable b) => NullifiableEq a b
6266instance (a ~ b, Nullifiable b) => NullifiableEq a b
6367
6468
65−runTag :: Nullability db a -> Expr Bool -> Expr a -> Expr (Maybe db)
69+runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)
6670runTag nullability tag a = case nullability of
6771 Nullable -> boolExpr null a tag
6872 NonNullable -> boolExpr null (nullify a) tag
@@ -70,7 +74,7 @@ runTag nullability tag a = case nullability of
7074 null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit
7175
7276
73−unnull :: Nullability db a -> Expr (Maybe db) -> Expr a
77+unnull :: Nullability a -> Expr (Nullify a) -> Expr a
7478unnull nullability a = case nullability of
7579 Nullable -> a
7680 NonNullable -> unsafeUnnullify a
src/Rel8/Schema/Field.hs+9−9
@@ -23,12 +23,12 @@ import Rel8.Schema.Spec ( Spec( Spec ) )
2323import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )
2424
2525
26−type Field :: K.Context -> Labels -> Necessity -> Type -> Type -> Type
27−type family Field labels context necessity db a where
28− Field Identity _labels _necessity _db a = a
29− Field Expr _labels _necessity _db a = Expr a
30− Field Insert _labels 'Required _db a = Expr a
31− Field Insert _labels 'Optional _db a = Maybe (Expr a)
32− Field Aggregate _labels _necessity _db a = Aggregate (Expr a)
33− Field Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)
34− Field context _labels _necessity _db a = context a
26+type Field :: K.Context -> Labels -> Necessity -> Type -> Type
27+type family Field labels context necessity a where
28+ Field Identity _labels _necessity a = a
29+ Field Expr _labels _necessity a = Expr a
30+ Field Insert _labels 'Required a = Expr a
31+ Field Insert _labels 'Optional a = Maybe (Expr a)
32+ Field Aggregate _labels _necessity a = Aggregate (Expr a)
33+ Field Structure labels necessity a = Shape1 'Column ('Spec labels necessity a)
34+ Field context _labels _necessity a = context a
src/Rel8/Schema/Generic.hs+24−24
@@ -315,10 +315,10 @@ instance
315315
316316type K1Columns :: Symbol -> Type -> K.HTable
317317type family K1Columns label structure where
318− K1Columns label (Shape1 'Column ('Spec '[] necessity nullability blueprint)) =
319− HIdentity ('Spec '[label] necessity nullability blueprint)
320− K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity nullability blueprint)) =
321− HIdentity ('Spec (label ': labels) necessity nullability blueprint)
318+ K1Columns label (Shape1 'Column ('Spec '[] necessity a)) =
319+ HIdentity ('Spec '[label] necessity a)
320+ K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity a)) =
321+ HIdentity ('Spec (label ': labels) necessity a)
322322 K1Columns label (Shape2 'Either a b) =
323323 HLabel label (HEitherTable (K1Columns "Left" a) (K1Columns "Right" b))
324324 K1Columns label (Shape1 'List a) = HListTable (K1Columns label a)
@@ -364,8 +364,8 @@ class isStructure ~ IsStructure structure =>
364364
365365
366366instance
367− ( x ~ Field Aggregate '[] necessity db a
368− ) => K1Table label Aggregate 'True (Shape1 'Column ('Spec '[] necessity db a)) x
367+ ( x ~ Field Aggregate '[] necessity a
368+ ) => K1Table label Aggregate 'True (Shape1 'Column ('Spec '[] necessity a)) x
369369 where
370370 fromK1Columns (HIdentity (Aggregation a)) = a
371371 toK1Columns = HIdentity . Aggregation
@@ -374,8 +374,8 @@ instance
374374
375375
376376instance
377− ( x ~ Field Aggregate (label ': labels) necessity db a
378− ) => K1Table _label Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
377+ ( x ~ Field Aggregate (label ': labels) necessity a
378+ ) => K1Table _label Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
379379 where
380380 fromK1Columns (HIdentity (Aggregation a)) = a
381381 toK1Columns = HIdentity . Aggregation
@@ -384,8 +384,8 @@ instance
384384
385385
386386instance
387− ( x ~ Field Expr '[] necessity db a
388− ) => K1Table label Expr 'True (Shape1 'Column ('Spec '[] necessity db a)) x
387+ ( x ~ Field Expr '[] necessity a
388+ ) => K1Table label Expr 'True (Shape1 'Column ('Spec '[] necessity a)) x
389389 where
390390 fromK1Columns (HIdentity (DB a)) = a
391391 toK1Columns = HIdentity . DB
@@ -394,8 +394,8 @@ instance
394394
395395
396396instance
397− ( x ~ Field Expr (label ': labels) necessity db a
398− ) => K1Table _label Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
397+ ( x ~ Field Expr (label ': labels) necessity a
398+ ) => K1Table _label Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
399399 where
400400 fromK1Columns (HIdentity (DB a)) = a
401401 toK1Columns = HIdentity . DB
@@ -404,9 +404,9 @@ instance
404404
405405
406406instance
407− ( x ~ Field Insert '[] necessity db a
407+ ( x ~ Field Insert '[] necessity a
408408 , KnownNecessity necessity
409− ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity db a)) x
409+ ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity a)) x
410410 where
411411 fromK1Columns (HIdentity insert) = case insert of
412412 RequiredInsert a -> a
@@ -419,9 +419,9 @@ instance
419419
420420
421421instance
422− ( x ~ Field Insert (label ': labels) necessity db a
422+ ( x ~ Field Insert (label ': labels) necessity a
423423 , KnownNecessity necessity
424− ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
424+ ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
425425 where
426426 fromK1Columns (HIdentity insert) = case insert of
427427 RequiredInsert a -> a
@@ -434,8 +434,8 @@ instance
434434
435435
436436instance
437− ( x ~ Field Identity '[] necessity db a
438− ) => K1Table label Identity 'True (Shape1 'Column ('Spec '[] necessity db a)) x
437+ ( x ~ Field Identity '[] necessity a
438+ ) => K1Table label Identity 'True (Shape1 'Column ('Spec '[] necessity a)) x
439439 where
440440 fromK1Columns (HIdentity (Result a)) = a
441441 toK1Columns = HIdentity . Result
@@ -444,8 +444,8 @@ instance
444444
445445
446446instance
447− ( x ~ Field Identity (label ': labels) necessity db a
448− ) => K1Table _label Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
447+ ( x ~ Field Identity (label ': labels) necessity a
448+ ) => K1Table _label Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
449449 where
450450 fromK1Columns (HIdentity (Result a)) = a
451451 toK1Columns = HIdentity . Result
@@ -454,8 +454,8 @@ instance
454454
455455
456456instance
457− ( x ~ Field Name '[] necessity db a
458− ) => K1Table _label Name 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
457+ ( x ~ Field Name '[] necessity a
458+ ) => K1Table _label Name 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
459459 where
460460 fromK1Columns (HIdentity (NameCol a)) = Name a
461461 toK1Columns (Name a) = HIdentity (NameCol a)
@@ -464,8 +464,8 @@ instance
464464
465465
466466instance
467− ( x ~ Field Name (label ': labels) necessity db a
468− ) => K1Table label Name 'True (Shape1 'Column ('Spec '[] necessity db a)) x
467+ ( x ~ Field Name (label ': labels) necessity a
468+ ) => K1Table label Name 'True (Shape1 'Column ('Spec '[] necessity a)) x
469469 where
470470 fromK1Columns = Name . (\(NameCol a) -> a) . unlabeler . unHIdentity
471471 toK1Columns = HIdentity . labeler . NameCol . (\(Name a) -> a)
src/Rel8/Schema/HTable/Either.hs+1−1
@@ -25,7 +25,7 @@ import Rel8.Type.Tag ( EitherTag )
2525
2626type HEitherTable :: K.HTable -> K.HTable -> K.HTable
2727data HEitherTable left right context = HEitherTable
28− { htag :: HIdentity ('Spec '["isRight"] 'Required EitherTag EitherTag) context
28+ { htag :: HIdentity ('Spec '["isRight"] 'Required EitherTag) context
2929 , hleft :: HNullify left context
3030 , hright :: HNullify right context
3131 }
src/Rel8/Schema/HTable/Label.hs+7−7
@@ -51,7 +51,7 @@ newtype HLabel label table context = HLabel (HMapTable (Label label) table conte
5151data Label :: Symbol -> Spec -> Exp Spec
5252
5353
54−type instance Eval (Label label ('Spec labels necessity db a)) = 'Spec (label : labels) necessity db a
54+type instance Eval (Label label ('Spec labels necessity a)) = 'Spec (label : labels) necessity a
5555
5656
5757instance KnownSymbol l => MapSpec (Label l) where
@@ -60,9 +60,9 @@ instance KnownSymbol l => MapSpec (Label l) where
6060
6161
6262hlabel :: (HTable t, KnownSymbol label)
63− => (forall labels necessity db a. ()
64− => context ('Spec labels necessity db a)
65− -> context ('Spec (label ': labels) necessity db a))
63+ => (forall labels necessity a. ()
64+ => context ('Spec labels necessity a)
65+ -> context ('Spec (label ': labels) necessity a))
6666 -> t context
6767 -> HLabel label t context
6868hlabel labeler a = HLabel $ htabulate $ \(HMapTableField field) ->
@@ -72,9 +72,9 @@ hlabel labeler a = HLabel $ htabulate $ \(HMapTableField field) ->
7272
7373
7474hunlabel :: (HTable t, KnownSymbol label)
75− => (forall labels necessity db a. ()
76− => context ('Spec (label ': labels) necessity db a)
77− -> context ('Spec labels necessity db a))
75+ => (forall labels necessity a. ()
76+ => context ('Spec (label ': labels) necessity a)
77+ -> context ('Spec labels necessity a))
7878 -> HLabel label t context
7979 -> t context
8080hunlabel unlabler (HLabel as) =
src/Rel8/Schema/HTable/Maybe.hs+1−1
@@ -29,7 +29,7 @@ import Rel8.Schema.HTable.Nullify ( HNullify )
2929
3030type HMaybeTable :: K.HTable -> K.HTable
3131data HMaybeTable table context = HMaybeTable
32− { htag :: HIdentity ('Spec '["isJust"] 'Required MaybeTag (Maybe MaybeTag)) context
32+ { htag :: HIdentity ('Spec '["isJust"] 'Required (Maybe MaybeTag)) context
3333 , hjust :: HNullify table context
3434 }
3535 deriving stock Generic
src/Rel8/Schema/HTable/Nullify.hs+13−12
@@ -35,6 +35,7 @@ import Rel8.Schema.HTable
3535 )
3636import qualified Rel8.Schema.Kind as K
3737import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
38+import qualified Rel8.Schema.Nullability as Type ( Nullify )
3839import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
3940
4041-- semigroupoids
@@ -55,8 +56,8 @@ newtype HNullify table context = HNullify (HMapTable Nullify table context)
5556data Nullify :: Spec -> Exp Spec
5657
5758
58−type instance Eval (Nullify ('Spec labels necessity dbType _)) =
59− 'Spec labels necessity dbType (Maybe dbType)
59+type instance Eval (Nullify ('Spec labels necessity a)) =
60+ 'Spec labels necessity (Type.Nullify a)
6061
6162
6263instance MapSpec Nullify where
@@ -72,8 +73,8 @@ instance MapSpec Nullify where
7273
7374
7475hnulls :: HTable t
75− => (forall labels necessity dbType. ()
76− => context ('Spec labels necessity dbType (Maybe dbType)))
76+ => (forall labels necessity a. ()
77+ => context ('Spec labels necessity (Maybe a)))
7778 -> HNullify t context
7879hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of
7980 SSpec {} -> null
@@ -81,10 +82,10 @@ hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspe
8182
8283
8384hnullify :: HTable t
84− => (forall labels necessity dbType a. ()
85− => SSpec ('Spec labels necessity dbType a)
86− -> context ('Spec labels necessity dbType a)
87− -> context ('Spec labels necessity dbType (Maybe dbType)))
85+ => (forall labels necessity a. ()
86+ => SSpec ('Spec labels necessity a)
87+ -> context ('Spec labels necessity a)
88+ -> context ('Spec labels necessity (Type.Nullify a)))
8889 -> t context
8990 -> HNullify t context
9091hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->
@@ -94,10 +95,10 @@ hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->
9495
9596
9697hunnullify :: (HTable t, Apply m)
97− => (forall labels necessity dbType a. ()
98− => SSpec ('Spec labels necessity dbType a)
99− -> context ('Spec labels necessity dbType (Maybe dbType))
100− -> m (context ('Spec labels necessity dbType a)))
98+ => (forall labels necessity a. ()
99+ => SSpec ('Spec labels necessity a)
100+ -> context ('Spec labels necessity (Type.Nullify a))
101+ -> m (context ('Spec labels necessity a)))
101102 -> HNullify t context
102103 -> m (t context)
103104hunnullify unnullifier (HNullify as) =
src/Rel8/Schema/HTable/These.hs+2−2
@@ -25,9 +25,9 @@ import Rel8.Type.Tag ( MaybeTag )
2525
2626type HTheseTable :: K.HTable -> K.HTable -> K.HTable
2727data HTheseTable here there context = HTheseTable
28− { hhereTag :: HIdentity ('Spec '["hasHere"] 'Required MaybeTag (Maybe MaybeTag)) context
28+ { hhereTag :: HIdentity ('Spec '["hasHere"] 'Required (Maybe MaybeTag)) context
2929 , hhere :: HNullify here context
30− , hthereTag :: HIdentity ('Spec '["hasThere"] 'Required MaybeTag (Maybe MaybeTag)) context
30+ , hthereTag :: HIdentity ('Spec '["hasThere"] 'Required (Maybe MaybeTag)) context
3131 , hthere :: HNullify there context
3232 }
3333 deriving stock Generic
src/Rel8/Schema/HTable/Type.hs+4−4
@@ -23,24 +23,24 @@ import Rel8.Schema.HTable
2323 , hfield, htabulate, htraverse, hdicts, hspecs
2424 )
2525import qualified Rel8.Schema.Kind as K
26−import Rel8.Schema.Nullability ( Unnullify, Sql, nullabilization )
26+import Rel8.Schema.Nullability ( Sql, nullabilization )
2727import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
2828import Rel8.Type ( DBType, typeInformation )
2929
3030
3131type HType :: Type -> K.HTable
3232newtype HType a context = HType
33− { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)
33+ { unHType :: context ('Spec '[""] 'Required a)
3434 }
3535
3636
3737type HTypeField :: Type -> Spec -> Type
3838data HTypeField a spec where
39− HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)
39+ HTypeField :: HTypeField a ('Spec '[""] 'Required a)
4040
4141
4242instance Sql DBType a => HTable (HType a) where
43− type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)
43+ type HConstrainTable (HType a) c = c ('Spec '[""] 'Required a)
4444 type HField (HType a) = HTypeField a
4545
4646 hfield (HType a) HTypeField = a
src/Rel8/Schema/HTable/Vectorize.hs+27−23
@@ -42,7 +42,11 @@ import Rel8.Schema.HTable
4242 ( HTable
4343 , hfield, htabulate, htabulateA, hspecs
4444 )
45−import Rel8.Schema.Nullability ( IsMaybe, Nullability( NonNullable ) )
45+import Rel8.Schema.Nullability
46+ ( IsMaybe
47+ , Unnullify
48+ , Nullability( NonNullable )
49+ )
4650import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
4751import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
4852import Rel8.Type.Information ( TypeInformation )
@@ -57,9 +61,9 @@ import GHC.Generics (Generic)
5761class Vector list where
5862 listIsn'tMaybe :: proxy a -> IsMaybe (list a) :~: 'False
5963 vectorTypeInformation :: ()
60− => Nullability a ma
61− -> TypeInformation a
62− -> TypeInformation (list ma)
64+ => Nullability a
65+ -> TypeInformation (Unnullify a)
66+ -> TypeInformation (list a)
6367
6468
6569instance Vector [] where
@@ -81,7 +85,7 @@ newtype HVectorize list table context = HVectorize (HMapTable (Vectorize list) t
8185data Vectorize :: (Type -> Type) -> Spec -> Exp Spec
8286
8387
84−type instance Eval (Vectorize list ('Spec labels necessity _ a)) = 'Spec labels necessity (list a) (list a)
88+type instance Eval (Vectorize list ('Spec labels necessity a)) = 'Spec labels necessity (list a)
8589
8690
8791instance Vector list => MapSpec (Vectorize list) where
@@ -95,10 +99,10 @@ instance Vector list => MapSpec (Vectorize list) where
9599
96100
97101hvectorize :: (HTable t, Unzip f, Vector list)
98− => (forall labels necessity db a. ()
99− => SSpec ('Spec labels necessity db a)
100− -> f (context ('Spec labels necessity db a))
101− -> context' ('Spec labels necessity (list a) (list a)))
102+ => (forall labels necessity a. ()
103+ => SSpec ('Spec labels necessity a)
104+ -> f (context ('Spec labels necessity a))
105+ -> context' ('Spec labels necessity (list a)))
102106 -> f (t context)
103107 -> HVectorize list t context'
104108hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->
@@ -108,10 +112,10 @@ hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->
108112
109113
110114hunvectorize :: (HTable t, Repeat f, Vector list)
111− => (forall labels necessity db a. ()
112− => SSpec ('Spec labels necessity db a)
113− -> context ('Spec labels necessity (list a) (list a))
114− -> f (context' ('Spec labels necessity db a)))
115+ => (forall labels necessity a. ()
116+ => SSpec ('Spec labels necessity a)
117+ -> context ('Spec labels necessity (list a))
118+ -> f (context' ('Spec labels necessity a)))
115119 -> HVectorize list t context
116120 -> f (t context')
117121hunvectorize unvectorizer (HVectorize table) =
@@ -122,12 +126,12 @@ hunvectorize unvectorizer (HVectorize table) =
122126
123127
124128happend :: (HTable t, Vector list) =>
125− ( forall labels necessity db a. ()
126− => Nullability db a
127− -> TypeInformation db
128− -> context ('Spec labels necessity (list a) (list a))
129− -> context ('Spec labels necessity (list a) (list a))
130− -> context ('Spec labels necessity (list a) (list a))
129+ ( forall labels necessity a. ()
130+ => Nullability a
131+ -> TypeInformation (Unnullify a)
132+ -> context ('Spec labels necessity (list a))
133+ -> context ('Spec labels necessity (list a))
134+ -> context ('Spec labels necessity (list a))
131135 )
132136 -> HVectorize list t context
133137 -> HVectorize list t context
@@ -139,10 +143,10 @@ happend append (HVectorize as) (HVectorize bs) = HVectorize $
139143
140144
141145hempty :: HTable t =>
142− ( forall labels necessity db a. ()
143− => Nullability db a
144− -> TypeInformation db
145− -> context ('Spec labels necessity [a] [a])
146+ ( forall labels necessity a. ()
147+ => Nullability a
148+ -> TypeInformation (Unnullify a)
149+ -> context ('Spec labels necessity [a])
146150 )
147151 -> HVectorize [] t context
148152hempty empty = HVectorize $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of
src/Rel8/Schema/Insert.hs+2−2
@@ -76,8 +76,8 @@ data Insert a where
7676
7777instance Interpretation Insert where
7878 data Col Insert _spec where
79− RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required db a)
80− OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional db a)
79+ RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required a)
80+ OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)
8181
8282
8383type Insertion :: K.Context
src/Rel8/Schema/Name.hs+2−2
@@ -98,8 +98,8 @@ instance Nullifiable Name where
9898 {-# INLINABLE unnullifier #-}
9999
100100
101−nameFromLabel :: forall labels necessity db a.
102− KnownLabels labels => Col Name ('Spec labels necessity db a)
101+nameFromLabel :: forall labels necessity a.
102+ KnownLabels labels => Col Name ('Spec labels necessity a)
103103nameFromLabel = case labelsSing @labels of
104104 labels -> NameCol (NonEmpty.last (renderLabels labels))
105105
src/Rel8/Schema/Nullability.hs+20−22
@@ -15,7 +15,7 @@ module Rel8.Schema.Nullability
1515 ( IsMaybe, Nullify, Unnullify
1616 , Nullability( Nullable, NonNullable )
1717 , Sql
18− , Nullabilizes, nullabilization
18+ , HasNullability, nullabilization
1919 )
2020where
2121
@@ -53,35 +53,34 @@ type Nullify :: Type -> Type
5353type Nullify a = Maybe (Unnullify a)
5454
5555
56−type Nullability :: Type -> Type -> Type
57−data Nullability a ma where
58− NonNullable :: IsMaybe a ~ 'False => Nullability a a
59− Nullable :: IsMaybe a ~ 'False => Nullability a (Maybe a)
56+type Nullability :: Type -> Type
57+data Nullability a where
58+ NonNullable :: IsMaybe a ~ 'False => Nullability a
59+ Nullable :: IsMaybe a ~ 'False => Nullability (Maybe a)
6060
6161
62−type Nullabilizes' :: Bool -> Type -> Type -> Constraint
62+type HasNullability' :: Bool -> Type -> Constraint
6363class
64− ( IsMaybe ma ~ isMaybe
65− , IsMaybe a ~ 'False
66− , Unnullify ma ~ a
67− , Nullify' isMaybe a ~ ma
68− ) => Nullabilizes' isMaybe a ma | isMaybe ma -> a, isMaybe a -> ma
64+ ( IsMaybe a ~ isMaybe
65+ , IsMaybe (Unnullify a) ~ 'False
66+ , Nullify' isMaybe (Unnullify a) ~ a
67+ ) => HasNullability' isMaybe a
6968 where
70− nullabilization' :: Nullability a ma
69+ nullabilization' :: Nullability a
7170
7271
73−instance IsMaybe a ~ 'False => Nullabilizes' 'False a a where
72+instance IsMaybe a ~ 'False => HasNullability' 'False a where
7473 nullabilization' = NonNullable
7574
7675
77−instance IsMaybe a ~ 'False => Nullabilizes' 'True a (Maybe a) where
76+instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where
7877 nullabilization' = Nullable
7978
8079
81−type Nullabilizes :: Type -> Type -> Constraint
82−class Nullabilizes' (IsMaybe ma) a ma => Nullabilizes a ma
83−instance Nullabilizes' (IsMaybe ma) a ma => Nullabilizes a ma
84−instance {-# OVERLAPPING #-} Nullabilizes Opaque Opaque
80+type HasNullability :: Type -> Constraint
81+class HasNullability' (IsMaybe a) a => HasNullability a
82+instance HasNullability' (IsMaybe a) a => HasNullability a
83+instance {-# OVERLAPPING #-} HasNullability Opaque
8584
8685
8786-- | The @Sql@ type class describes both null and not null database values,
@@ -93,14 +92,13 @@ instance {-# OVERLAPPING #-} Nullabilizes Opaque Opaque
9392type Sql :: (Type -> Constraint) -> Type -> Constraint
9493class
9594 ( (forall c. (forall x. (constraint x => c x)) => Sql c a)
96− , Nullabilizes (Unnullify a) a
95+ , HasNullability a
9796 , constraint (Unnullify a)
9897 )
9998 => Sql constraint a
100−instance (constraint db, Nullabilizes db a) => Sql constraint a
99+instance (constraint (Unnullify a), HasNullability a) => Sql constraint a
101100instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque
102−-- instance {-# OVERLAPPING #-} Sql OpaqueC Opaque => Sql OpaqueC Opaque
103101
104102
105−nullabilization :: forall a db. Nullabilizes db a => Nullability db a
103+nullabilization :: HasNullability a => Nullability a
106104nullabilization = nullabilization'
src/Rel8/Schema/Spec.hs+6−7
@@ -24,13 +24,13 @@ import Rel8.Kind.Necessity
2424 , SNecessity
2525 , KnownNecessity, necessitySing
2626 )
27−import Rel8.Schema.Nullability ( Unnullify, Nullability, Sql, nullabilization )
27+import Rel8.Schema.Nullability ( Nullability, Sql, Unnullify, nullabilization )
2828import Rel8.Type ( DBType, typeInformation )
2929import Rel8.Type.Information ( TypeInformation )
3030
3131
3232type Spec :: Type
33−data Spec = Spec Labels Necessity Type Type
33+data Spec = Spec Labels Necessity Type
3434
3535
3636type SSpec :: Spec -> Type
@@ -38,10 +38,10 @@ data SSpec spec where
3838 SSpec ::
3939 { labels :: SLabels labels
4040 , necessity :: SNecessity necessity
41− , info :: TypeInformation db
42− , nullability :: Nullability db a
41+ , info :: TypeInformation (Unnullify a)
42+ , nullability :: Nullability a
4343 }
44− -> SSpec ('Spec labels necessity db a)
44+ -> SSpec ('Spec labels necessity a)
4545
4646
4747type KnownSpec :: Spec -> Constraint
@@ -53,9 +53,8 @@ instance
5353 ( KnownLabels labels
5454 , KnownNecessity necessity
5555 , Sql DBType a
56− , db ~ Unnullify a
5756 )
58− => KnownSpec ('Spec labels necessity db a)
57+ => KnownSpec ('Spec labels necessity a)
5958 where
6059 specSing = SSpec
6160 { labels = labelsSing
src/Rel8/Schema/Spec/ConstrainDBType.hs+6−5
@@ -17,18 +17,19 @@ import Data.Kind ( Constraint, Type )
1717import Prelude ()
1818
1919-- rel8
20+import Rel8.Schema.Nullability ( Sql )
2021import Rel8.Schema.Spec ( Spec( Spec ) )
2122
2223
2324type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint
2425class
25− ( forall labels necessity db a. ()
26− => (spec ~ 'Spec labels necessity db a)
27− => constraint db
26+ ( forall c labels necessity a. ()
27+ => (spec ~ 'Spec labels necessity a)
28+ => (forall x. (constraint x => c x)) => Sql c a
2829 )
2930 => ConstrainDBType constraint spec
3031instance
31− ( spec ~ 'Spec labels necessity db a
32− , constraint db
32+ ( spec ~ 'Spec labels necessity a
33+ , Sql constraint a
3334 )
3435 => ConstrainDBType constraint spec
src/Rel8/Schema/Spec/ConstrainType.hs+3−3
@@ -22,10 +22,10 @@ import Rel8.Schema.Spec ( Spec( Spec ) )
2222
2323type ConstrainType :: (Type -> Constraint) -> Spec -> Constraint
2424class
25− ( forall labels necessity db a. ()
26− => (spec ~ 'Spec labels necessity db a)
25+ ( forall labels necessity a. ()
26+ => (spec ~ 'Spec labels necessity a)
2727 => constraint a
2828 ) =>
2929 ConstrainType constraint spec
30−instance (spec ~ 'Spec labels necessity db a, constraint a) =>
30+instance (spec ~ 'Spec labels necessity a, constraint a) =>
3131 ConstrainType constraint spec
src/Rel8/Table/Aggregate.hs+4−6
@@ -20,11 +20,10 @@ import Prelude
2020-- rel8
2121import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )
2222import Rel8.Expr ( Expr, Col(..) )
23−import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr, sgroupByExpr )
23+import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
2424import Rel8.Schema.Dict ( Dict( Dict ) )
25−import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )
25+import Rel8.Schema.HTable ( htabulate, hfield, hdicts )
2626import Rel8.Schema.HTable.Vectorize ( hvectorize )
27−import Rel8.Schema.Spec ( SSpec(..) )
2827import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
2928import Rel8.Table ( Table, Columns, toColumns, fromColumns )
3029import Rel8.Table.Eq ( EqTable )
@@ -38,9 +37,8 @@ import Rel8.Type.Eq ( DBEq )
3837groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs
3938groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
4039 case hfield dicts field of
41− Dict -> case hfield hspecs field of
42− SSpec {nullability} -> case hfield exprs field of
43− DB expr -> Aggregation $ sgroupByExpr nullability expr
40+ Dict -> case hfield exprs field of
41+ DB expr -> Aggregation $ groupByExpr expr
4442 where
4543 dicts = hdicts @(Columns exprs) @(ConstrainDBType DBEq)
4644
src/Rel8/Table/Eq.hs+5−14
@@ -20,20 +20,15 @@ import Data.Foldable ( foldl' )
2020import Data.Functor.Const ( Const( Const ), getConst )
2121import Data.Kind ( Constraint, Type )
2222import Data.List.NonEmpty ( NonEmpty( (:|) ) )
23−import Prelude hiding ( seq )
23+import Prelude
2424
2525-- rel8
2626import Rel8.Expr ( Expr, Col(..) )
2727import Rel8.Expr.Bool ( (||.), (&&.) )
28−import Rel8.Expr.Eq ( seq, sne )
28+import Rel8.Expr.Eq ( (==.), (/=.) )
2929import Rel8.Opaque ( Opaque )
3030import Rel8.Schema.Dict ( Dict( Dict ) )
31−import Rel8.Schema.HTable
32− ( HConstrainTable
33− , htabulateA, hfield
34− , hdicts, hspecs
35− )
36−import Rel8.Schema.Spec ( SSpec(..) )
31+import Rel8.Schema.HTable ( HConstrainTable, htabulateA, hfield, hdicts )
3732import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
3833import Rel8.Table ( Table, Columns, toColumns )
3934import Rel8.Type.Eq ( DBEq )
@@ -59,11 +54,9 @@ instance {-# OVERLAPPING #-} EqTable Opaque
5954 foldl1' (&&.) $ getConst $ htabulateA $ \field ->
6055 case (hfield as field, hfield bs field) of
6156 (DB a, DB b) -> case hfield dicts field of
62− Dict -> case hfield specs field of
63− SSpec {nullability} -> Const (pure (seq nullability a b))
57+ Dict -> Const (pure (a ==. b))
6458 where
6559 dicts = hdicts @(Columns a) @(ConstrainDBType DBEq)
66− specs = hspecs @(Columns a)
6760infix 4 ==:
6861
6962
@@ -75,11 +68,9 @@ infix 4 ==:
7568 foldl1' (||.) $ getConst $ htabulateA $ \field ->
7669 case (hfield as field, hfield bs field) of
7770 (DB a, DB b) -> case hfield dicts field of
78− Dict -> case hfield specs field of
79− SSpec {nullability} -> Const (pure (sne nullability a b))
71+ Dict -> Const (pure (a /=. b))
8072 where
8173 dicts = hdicts @(Columns a) @(ConstrainDBType DBEq)
82− specs = hspecs @(Columns a)
8374infix 4 /=:
8475
8576
src/Rel8/Table/Opaleye.hs+9−10
@@ -96,16 +96,15 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $
9696 name -> lmap (`hfield` field) (go specs name)
9797 where
9898 go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
99− go SSpec {necessity, info, nullability} (NameCol name) =
100− case necessity of
101− SRequired ->
102− lmap (\(RequiredInsert a) -> toColumn $ toPrimExpr a) $
103− DB . scastExpr nullability info . fromPrimExpr . fromColumn <$>
104− Opaleye.requiredTableField name
105− SOptional ->
106− lmap (\(OptionalInsert ma) -> toColumn . toPrimExpr <$> ma) $
107− DB . scastExpr nullability info . fromPrimExpr . fromColumn <$>
108− Opaleye.optionalTableField name
99+ go SSpec {necessity, info} (NameCol name) = case necessity of
100+ SRequired ->
101+ lmap (\(RequiredInsert a) -> toColumn $ toPrimExpr a) $
102+ DB . scastExpr info . fromPrimExpr . fromColumn <$>
103+ Opaleye.requiredTableField name
104+ SOptional ->
105+ lmap (\(OptionalInsert ma) -> toColumn . toPrimExpr <$> ma) $
106+ DB . scastExpr info . fromPrimExpr . fromColumn <$>
107+ Opaleye.optionalTableField name
109108
110109
111110unpackspec :: Table Expr a => Opaleye.Unpackspec a a
src/Rel8/Table/Ord.hs+7−24
@@ -22,16 +22,11 @@ import Prelude hiding ( seq )
2222-- rel8
2323import Rel8.Expr ( Expr, Col(..) )
2424import Rel8.Expr.Bool ( (||.), (&&.), false, true )
25−import Rel8.Expr.Eq ( seq )
26−import Rel8.Expr.Ord ( slt, sgt)
25+import Rel8.Expr.Eq ( (==.) )
26+import Rel8.Expr.Ord ( (<.), (>.) )
2727import Rel8.Opaque ( Opaque )
2828import Rel8.Schema.Dict ( Dict( Dict ) )
29−import Rel8.Schema.HTable
30− ( HConstrainTable
31− , htabulateA, hfield
32− , hdicts, hspecs
33− )
34−import Rel8.Schema.Spec ( SSpec(..) )
29+import Rel8.Schema.HTable ( HConstrainTable, htabulateA, hfield, hdicts )
3530import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
3631import Rel8.Table ( Columns, toColumns )
3732import Rel8.Table.Bool ( bool )
@@ -61,12 +56,9 @@ instance {-# OVERLAPPING #-} OrdTable Opaque
6156 foldr @[] go false $ getConst $ htabulateA $ \field ->
6257 case (hfield as field, hfield bs field) of
6358 (DB a, DB b) -> case hfield dicts field of
64− Dict -> case hfield specs field of
65− SSpec {nullability} ->
66− Const [(slt nullability a b, seq nullability a b)]
59+ Dict -> Const [(a <. b, a ==. b)]
6760 where
6861 dicts = hdicts @(Columns a) @(ConstrainDBType DBOrd)
69− specs = hspecs @(Columns a)
7062 go (lt, eq) a = lt ||. (eq &&. a)
7163infix 4 <:
7264
@@ -78,12 +70,9 @@ infix 4 <:
7870 foldr @[] go true $ getConst $ htabulateA $ \field ->
7971 case (hfield as field, hfield bs field) of
8072 (DB a, DB b) -> case hfield dicts field of
81− Dict -> case hfield specs field of
82− SSpec {nullability} ->
83− Const [(slt nullability a b, seq nullability a b)]
73+ Dict -> Const [(a <. b, a ==. b)]
8474 where
8575 dicts = hdicts @(Columns a) @(ConstrainDBType DBOrd)
86− specs = hspecs @(Columns a)
8776 go (lt, eq) a = lt ||. (eq &&. a)
8877infix 4 <=:
8978
@@ -95,12 +84,9 @@ infix 4 <=:
9584 foldr @[] go false $ getConst $ htabulateA $ \field ->
9685 case (hfield as field, hfield bs field) of
9786 (DB a, DB b) -> case hfield dicts field of
98− Dict -> case hfield specs field of
99− SSpec {nullability} ->
100− Const [(slt nullability a b, seq nullability a b)]
87+ Dict -> Const [(a >. b, a ==. b)]
10188 where
10289 dicts = hdicts @(Columns a) @(ConstrainDBType DBOrd)
103− specs = hspecs @(Columns a)
10490 go (gt, eq) a = gt ||. (eq &&. a)
10591infix 4 >:
10692
@@ -112,12 +98,9 @@ infix 4 >:
11298 foldr @[] go true $ getConst $ htabulateA $ \field ->
11399 case (hfield as field, hfield bs field) of
114100 (DB a, DB b) -> case hfield dicts field of
115− Dict -> case hfield specs field of
116− SSpec {nullability} ->
117− Const [(sgt nullability a b, seq nullability a b)]
101+ Dict -> Const [(a >. b, a ==. b)]
118102 where
119103 dicts = hdicts @(Columns a) @(ConstrainDBType DBOrd)
120− specs = hspecs @(Columns a)
121104 go (gt, eq) a = gt ||. (eq &&. a)
122105infix 4 >=:
123106
src/Rel8/Table/Order.hs+40−14
@@ -1,3 +1,4 @@
1+{-# language DataKinds #-}
12{-# language NamedFieldPuns #-}
23{-# language ScopedTypeVariables #-}
34{-# language TypeApplications #-}
@@ -20,8 +21,11 @@ import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
2021import Rel8.Order ( Order )
2122import Rel8.Schema.Dict ( Dict( Dict ) )
2223import Rel8.Schema.HTable (htabulateA, hfield, hdicts, hspecs)
23−import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
24−import Rel8.Schema.Spec ( SSpec(..) )
24+import Rel8.Schema.Nullability
25+ ( Unnullify, Nullability( Nullable, NonNullable )
26+ , Sql, nullabilization
27+ )
28+import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec ) )
2529import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
2630import Rel8.Table
2731import Rel8.Table.Ord
@@ -33,12 +37,13 @@ import Rel8.Type.Ord
3337ascTable :: forall a. OrdTable a => Order a
3438ascTable = contramap toColumns $ getConst $
3539 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
36− SSpec {nullability} -> case hfield ords field of
37− Dict -> Const $ unDB . (`hfield` field) >$< case nullability of
38− Nullable -> nullsFirst asc
39− NonNullable -> asc
40− where
41− ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
40+ SSpec {} -> case hfield ords field of
41+ dict@Dict -> case ord dict of
42+ Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of
43+ Nullable -> nullsFirst asc
44+ NonNullable -> asc
45+ where
46+ ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
4247
4348
4449-- | Construct an 'Order' for a 'Table' by sorting all columns into descending
@@ -46,9 +51,30 @@ ascTable = contramap toColumns $ getConst $
4651descTable :: forall a. OrdTable a => Order a
4752descTable = contramap toColumns $ getConst $
4853 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
49− SSpec {nullability} -> case hfield ords field of
50− Dict -> Const $ unDB . (`hfield` field) >$< case nullability of
51− Nullable -> nullsLast desc
52− NonNullable -> desc
53− where
54− ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
54+ SSpec {} -> case hfield ords field of
55+ dict@Dict -> case ord dict of
56+ Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of
57+ Nullable -> nullsLast desc
58+ NonNullable -> desc
59+ where
60+ ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
61+
62+
63+nullability :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Nullability a
64+nullability = step2 . step1
65+ where
66+ step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a
67+ step1 Dict = Dict
68+
69+ step2 :: Dict (Sql DBOrd) a -> Nullability a
70+ step2 Dict = nullabilization
71+
72+
73+ord :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict DBOrd (Unnullify a)
74+ord = step2 . step1
75+ where
76+ step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a
77+ step1 Dict = Dict
78+
79+ step2 :: Dict (Sql DBOrd) a -> Dict DBOrd (Unnullify a)
80+ step2 Dict = Dict
src/Rel8/Table/Undefined.hs+2−2
@@ -22,5 +22,5 @@ import Rel8.Table ( Table, fromColumns )
2222undefined :: Table Expr a => a
2323undefined = fromColumns $ htabulate $ \field -> case hfield hspecs field of
2424 SSpec {nullability, info} -> case nullability of
25− Nullable -> DB (snull Nullable info)
26− NonNullable -> DB (unsafeUnnullify (snull Nullable info))
25+ Nullable -> DB (snull info)
26+ NonNullable -> DB (unsafeUnnullify (snull info))
src/Rel8/Type/Array.hs+7−7
@@ -22,7 +22,7 @@ import qualified Hasql.Decoders as Hasql
2222import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2323
2424-- rel8
25−import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
25+import Rel8.Schema.Nullability ( Unnullify, Nullability( Nullable, NonNullable ) )
2626import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )
2727
2828
@@ -35,9 +35,9 @@ array TypeInformation {typeName} =
3535
3636
3737listTypeInformation :: ()
38− => Nullability a ma
39− -> TypeInformation a
40− -> TypeInformation [ma]
38+ => Nullability a
39+ -> TypeInformation (Unnullify a)
40+ -> TypeInformation [a]
4141listTypeInformation nullability info =
4242 case info of
4343 TypeInformation{ encode, decode, out } -> TypeInformation
@@ -56,9 +56,9 @@ listTypeInformation nullability info =
5656
5757
5858nonEmptyTypeInformation :: ()
59− => Nullability a ma
60− -> TypeInformation a
61− -> TypeInformation (NonEmpty ma)
59+ => Nullability a
60+ -> TypeInformation (Unnullify a)
61+ -> TypeInformation (NonEmpty a)
6262nonEmptyTypeInformation nullability =
6363 parseTypeInformation parse toList . listTypeInformation nullability
6464 where
src/Rel8/Type/Array1D.hs+3−3
@@ -92,9 +92,9 @@ type family IsArray1D a where
9292 IsArray1D _ = 'False
9393
9494
95−array1DTypeInformation :: IsArray1D db ~ 'False
96− => Nullability db a
97− -> TypeInformation db
95+array1DTypeInformation :: IsArray1D (Unnullify a) ~ 'False
96+ => Nullability a
97+ -> TypeInformation (Unnullify a)
9898 -> TypeInformation (Array1D a)
9999array1DTypeInformation nullability info =
100100 case info of