git.iko.soy/rel8
on master help sign in
Tidy up IsMaybe ~ 'False with NotNull constraint synonym (fixes #23)
commitc220b0011ac7dd1e06ee3628bed1f63efb05b024 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 25 Mar 2021, 02:21 (6 years ago) parent53616d0
7 files changed+54−41
compare with master
unifiedsplit
src/Rel8.hs+1−1 src/Rel8/Expr/Null.hs+8−9 src/Rel8/Expr/Num.hs+7−7 src/Rel8/Schema/HTable/Vectorize.hs+8−8 src/Rel8/Schema/Nullability.hs+25−11 src/Rel8/Table/Serialize.hs+3−3 src/Rel8/Type.hs+2−2
src/Rel8.hs+1−1
@@ -234,10 +234,10 @@ module Rel8
234234 -- These need organizing, but are reachable from Rel8's documentation so we
235235 -- do need to export and document them.
236236 , HasNullability
237+ , NotNull
237238 , HTable
238239 , Labelable
239240 , Context
240− , IsMaybe
241241 ) where
242242
243243-- base
src/Rel8/Expr/Null.hs+8−9
@@ -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 ( IsMaybe )
26+import Rel8.Schema.Nullability ( NotNull )
2727import Rel8.Type ( DBType, typeInformation )
2828import Rel8.Type.Information ( TypeInformation )
2929
@@ -31,7 +31,7 @@ import Rel8.Type.Information ( TypeInformation )
3131-- | Lift an expression that can't be @null@ to a type that might be @null@.
3232-- This is an identity operation in terms of any generated query, and just
3333-- modifies the query's type.
34−nullify :: IsMaybe a ~ 'False => Expr a -> Expr (Maybe a)
34+nullify :: NotNull a => Expr a -> Expr (Maybe a)
3535nullify (Expr a) = Expr a
3636
3737
@@ -50,8 +50,7 @@ nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b
5050nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)
5151
5252
53−nullableOf :: (IsMaybe a ~ 'False, DBType a)
54− => Maybe (Expr a) -> Expr (Maybe a)
53+nullableOf :: DBType a => Maybe (Expr a) -> Expr (Maybe a)
5554nullableOf = maybe null nullify
5655
5756
@@ -75,7 +74,7 @@ isNonNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)
7574-- values. When given @null@, @mapNullable f@ returns @null@.
7675--
7776-- This is like 'fmap' for 'Maybe'.
78−mapNullable :: (IsMaybe b ~ 'False, DBType b)
77+mapNullable :: DBType b
7978 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)
8079mapNullable f ma = boolExpr (unsafeMapNullable f ma) null (isNull ma)
8180
@@ -85,7 +84,7 @@ mapNullable f ma = boolExpr (unsafeMapNullable f ma) null (isNull ma)
8584-- are @null@, @liftOpNullable@ returns @null@.
8685--
8786-- This is like 'liftA2' for 'Maybe'.
88−liftOpNullable :: (IsMaybe c ~ 'False, DBType c)
87+liftOpNullable :: DBType c
8988 => (Expr a -> Expr b -> Expr c)
9089 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)
9190liftOpNullable f ma mb =
@@ -98,16 +97,16 @@ snull info = scastExpr info $ Expr $ Opaleye.ConstExpr Opaleye.NullLit
9897
9998
10099-- | Corresponds to SQL @null@.
101−null :: (IsMaybe a ~ 'False, DBType a) => Expr (Maybe a)
100+null :: DBType a => Expr (Maybe a)
102101null = snull typeInformation
103102
104103
105−unsafeMapNullable :: IsMaybe b ~ 'False
104+unsafeMapNullable :: NotNull b
106105 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)
107106unsafeMapNullable f ma = nullify (f (unsafeUnnullify ma))
108107
109108
110−unsafeLiftOpNullable :: IsMaybe c ~ 'False
109+unsafeLiftOpNullable :: NotNull c
111110 => (Expr a -> Expr b -> Expr c)
112111 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)
113112unsafeLiftOpNullable f ma mb =
src/Rel8/Expr/Num.hs+7−7
@@ -15,21 +15,21 @@ import Prelude ()
1515import Rel8.Expr ( Expr( Expr ) )
1616import Rel8.Expr.Function ( function )
1717import Rel8.Expr.Opaleye ( castExpr )
18−import Rel8.Schema.Nullability ( IsMaybe, Sql )
18+import Rel8.Schema.Nullability ( Homonullable, Sql )
1919import Rel8.Type.Num ( DBFractional, DBIntegral, DBNum )
2020
2121
22−fromIntegral :: (Sql DBIntegral a, Sql DBNum b, IsMaybe a ~ IsMaybe b)
22+fromIntegral :: (Sql DBIntegral a, Sql DBNum b, Homonullable a b)
2323 => Expr a -> Expr b
2424fromIntegral (Expr a) = castExpr (Expr a)
2525
2626
27−realToFrac :: (Sql DBNum a, Sql DBFractional b, IsMaybe a ~ IsMaybe b)
27+realToFrac :: (Sql DBNum a, Sql DBFractional b, Homonullable a b)
2828 => Expr a -> Expr b
2929realToFrac (Expr a) = castExpr (Expr a)
3030
3131
32−ceiling :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)
32+ceiling :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
3333 => Expr a -> Expr b
3434ceiling = function "CEILING"
3535
@@ -42,16 +42,16 @@ mod :: Sql DBIntegral a => Expr a -> Expr a -> Expr a
4242mod = function "MOD"
4343
4444
45−floor :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)
45+floor :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
4646 => Expr a -> Expr b
4747floor = function "FLOOR"
4848
4949
50−round :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)
50+round :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
5151 => Expr a -> Expr b
5252round = function "ROUND"
5353
5454
55−truncate :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)
55+truncate :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)
5656 => Expr a -> Expr b
5757truncate = function "TRUNC"
src/Rel8/Schema/HTable/Vectorize.hs+8−8
@@ -32,19 +32,19 @@ where
3232-- base
3333import Data.Kind ( Type )
3434import Data.List.NonEmpty ( NonEmpty )
35−import Data.Type.Equality ( (:~:)( Refl ) )
3635import Prelude
3736
3837-- rel8
3938import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
39+import Rel8.Schema.Dict ( Dict( Dict ) )
4040import qualified Rel8.Schema.Kind as K
4141import Rel8.Schema.HTable
4242 ( HTable
4343 , hfield, htabulate, htabulateA, hspecs
4444 )
4545import Rel8.Schema.Nullability
46− ( IsMaybe
47− , Unnullify
46+ ( Unnullify
47+ , NotNull
4848 , Nullability( NonNullable )
4949 )
5050import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
@@ -59,7 +59,7 @@ import GHC.Generics (Generic)
5959
6060
6161class Vector list where
62− listIsn'tMaybe :: proxy a -> IsMaybe (list a) :~: 'False
62+ listNotNull :: proxy a -> Dict NotNull (list a)
6363 vectorTypeInformation :: ()
6464 => Nullability a
6565 -> TypeInformation (Unnullify a)
@@ -67,12 +67,12 @@ class Vector list where
6767
6868
6969instance Vector [] where
70− listIsn'tMaybe _ = Refl
70+ listNotNull _ = Dict
7171 vectorTypeInformation = listTypeInformation
7272
7373
7474instance Vector NonEmpty where
75− listIsn'tMaybe _ = Refl
75+ listNotNull _ = Dict
7676 vectorTypeInformation = nonEmptyTypeInformation
7777
7878
@@ -90,8 +90,8 @@ type instance Eval (Vectorize list ('Spec labels necessity a)) = 'Spec labels ne
9090
9191instance Vector list => MapSpec (Vectorize list) where
9292 mapInfo = \case
93− SSpec {..} -> case listIsn'tMaybe @list nullability of
94− Refl -> SSpec
93+ SSpec {..} -> case listNotNull @list nullability of
94+ Dict -> SSpec
9595 { nullability = NonNullable
9696 , info = vectorTypeInformation nullability info
9797 , ..
src/Rel8/Schema/Nullability.hs+25−11
@@ -12,10 +12,12 @@
1212{-# language UndecidableSuperClasses #-}
1313
1414module Rel8.Schema.Nullability
15− ( IsMaybe, Nullify, Unnullify
15+ ( Nullify, Unnullify
16+ , NotNull
17+ , Homonullable
1618 , Nullability( Nullable, NonNullable )
17− , Sql
1819 , HasNullability, nullabilization
20+ , Sql
1921 )
2022where
2123
@@ -53,27 +55,39 @@ type Nullify :: Type -> Type
5355type Nullify a = Maybe (Unnullify a)
5456
5557
58+type NotNull :: Type -> Constraint
59+class IsMaybe a ~ 'False => NotNull a
60+instance IsMaybe a ~ 'False => NotNull a
61+instance {-# OVERLAPPING #-} NotNull Opaque
62+
63+
64+type Homonullable :: Type -> Type -> Constraint
65+class IsMaybe a ~ IsMaybe b => Homonullable a b
66+instance IsMaybe a ~ IsMaybe b => Homonullable a b
67+instance {-# OVERLAPPING #-} Homonullable Opaque Opaque
68+
69+
5670type Nullability :: Type -> Type
5771data Nullability a where
58− NonNullable :: IsMaybe a ~ 'False => Nullability a
59− Nullable :: IsMaybe a ~ 'False => Nullability (Maybe a)
72+ NonNullable :: NotNull a => Nullability a
73+ Nullable :: NotNull a => Nullability (Maybe a)
6074
6175
6276type HasNullability' :: Bool -> Type -> Constraint
6377class
6478 ( IsMaybe a ~ isMaybe
65− , IsMaybe (Unnullify a) ~ 'False
79+ , NotNull (Unnullify a)
6680 , Nullify' isMaybe (Unnullify a) ~ a
6781 ) => HasNullability' isMaybe a
6882 where
6983 nullabilization' :: Nullability a
7084
7185
72−instance IsMaybe a ~ 'False => HasNullability' 'False a where
86+instance NotNull a => HasNullability' 'False a where
7387 nullabilization' = NonNullable
7488
7589
76−instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where
90+instance NotNull a => HasNullability' 'True (Maybe a) where
7791 nullabilization' = Nullable
7892
7993
@@ -83,6 +97,10 @@ instance HasNullability' (IsMaybe a) a => HasNullability a
8397instance {-# OVERLAPPING #-} HasNullability Opaque
8498
8599
100+nullabilization :: HasNullability a => Nullability a
101+nullabilization = nullabilization'
102+
103+
86104-- | The @Sql@ type class describes both null and not null database values,
87105-- constrained by a specific class.
88106--
@@ -98,7 +116,3 @@ class
98116 => Sql constraint a
99117instance (constraint (Unnullify a), HasNullability a) => Sql constraint a
100118instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque
101−
102−
103−nullabilization :: HasNullability a => Nullability a
104−nullabilization = nullabilization'
src/Rel8/Table/Serialize.hs+3−3
@@ -47,7 +47,7 @@ import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
4747import Rel8.Schema.HTable.Pair ( HPair(..) )
4848import Rel8.Schema.HTable.Trio ( HTrio(..) )
4949import Rel8.Schema.HTable.Type ( HType(..) )
50−import Rel8.Schema.Nullability ( IsMaybe, Sql )
50+import Rel8.Schema.Nullability ( NotNull, Sql )
5151import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
5252import Rel8.Table ( Table, Columns, fromColumns, toColumns )
5353import Rel8.Table.Either ( EitherTable )
@@ -139,7 +139,7 @@ class (Table Expr exprs, isTabular ~ IsTabular a) =>
139139
140140instance
141141 ( DBType a
142− , IsMaybe a ~ 'False
142+ , NotNull a
143143 , IsTabular a ~ 'False
144144 , x ~ Expr a
145145 )
@@ -162,7 +162,7 @@ instance
162162instance
163163 ( Sql DBType a
164164 , isTabular ~ 'False
165− , IsMaybe a ~ 'False
165+ , NotNull a
166166 , IsMaybeTabular a ~ 'False
167167 , x ~ Maybe a
168168 ) => ExprsFor 'False 'False (Maybe a) (Expr x)
src/Rel8/Type.hs+2−2
@@ -36,7 +36,7 @@ import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
3636
3737-- rel8
3838import Rel8.Opaque ( Opaque )
39−import Rel8.Schema.Nullability ( Sql, nullabilization )
39+import Rel8.Schema.Nullability ( NotNull, Sql, nullabilization )
4040import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
4141import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
4242
@@ -82,7 +82,7 @@ import qualified Data.UUID as UUID
8282-- avoid making bad joins. However, when SQL is generated, it will be as if you
8383-- just used integers (the type distinction does not impact query generation).
8484type DBType :: Type -> Constraint
85−class DBType a where
85+class NotNull a => DBType a where
8686 typeInformation :: TypeInformation a
8787
8888