c220b00 · rel8 · git.iko.soy

src/Rel8.hs+1−1

compare with master

unifiedsplit

@@ -234,10 +234,10 @@ module Rel8

234 -- These need organizing, but are reachable from Rel8's documentation so we

235 -- do need to export and document them.

236 , HasNullability

237+ , NotNull

237 , HTable

238 , HTable

238 , Labelable

239 , Labelable

239 , Context

240 , Context

240− , IsMaybe

241 ) where

242

243-- base

src/Rel8/Expr/Null.hs+8−9

@@ -23,7 +23,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

23import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )

24import Rel8.Expr.Bool ( (||.), boolExpr )

25import Rel8.Expr.Opaleye ( scastExpr, mapPrimExpr )

26−import Rel8.Schema.Nullability ( IsMaybe )

26+import Rel8.Schema.Nullability ( NotNull )

27import Rel8.Type ( DBType, typeInformation )

28import Rel8.Type.Information ( TypeInformation )

29

@@ -31,7 +31,7 @@ import Rel8.Type.Information ( TypeInformation )

31-- | Lift an expression that can't be @null@ to a type that might be @null@.

32-- This is an identity operation in terms of any generated query, and just

33-- modifies the query's type.

34−nullify :: IsMaybe a ~ 'False => Expr a -> Expr (Maybe a)

34+nullify :: NotNull a => Expr a -> Expr (Maybe a)

35nullify (Expr a) = Expr a

36

37

@@ -50,8 +50,7 @@ nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b

50nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)

51

52

53−nullableOf :: (IsMaybe a ~ 'False, DBType a)

54− => Maybe (Expr a) -> Expr (Maybe a)

53+nullableOf :: DBType a => Maybe (Expr a) -> Expr (Maybe a)

55nullableOf = maybe null nullify

54nullableOf = maybe null nullify

56

55

57

56

@@ -75,7 +74,7 @@ isNonNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)

75-- values. When given @null@, @mapNullable f@ returns @null@.

74-- values. When given @null@, @mapNullable f@ returns @null@.

76--

75--

77-- This is like 'fmap' for 'Maybe'.

76-- This is like 'fmap' for 'Maybe'.

78−mapNullable :: (IsMaybe b ~ 'False, DBType b)

77+mapNullable :: DBType b

79 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)

78 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)

80mapNullable f ma = boolExpr (unsafeMapNullable f ma) null (isNull ma)

79mapNullable f ma = boolExpr (unsafeMapNullable f ma) null (isNull ma)

81

80

@@ -85,7 +84,7 @@ mapNullable f ma = boolExpr (unsafeMapNullable f ma) null (isNull ma)

85-- are @null@, @liftOpNullable@ returns @null@.

84-- are @null@, @liftOpNullable@ returns @null@.

86--

85--

87-- This is like 'liftA2' for 'Maybe'.

86-- This is like 'liftA2' for 'Maybe'.

88−liftOpNullable :: (IsMaybe c ~ 'False, DBType c)

87+liftOpNullable :: DBType c

89 => (Expr a -> Expr b -> Expr c)

88 => (Expr a -> Expr b -> Expr c)

90 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)

89 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)

91liftOpNullable f ma mb =

90liftOpNullable f ma mb =

@@ -98,16 +97,16 @@ snull info = scastExpr info $ Expr $ Opaleye.ConstExpr Opaleye.NullLit

98

97

99

98

100-- | Corresponds to SQL @null@.

99-- | Corresponds to SQL @null@.

101−null :: (IsMaybe a ~ 'False, DBType a) => Expr (Maybe a)

100+null :: DBType a => Expr (Maybe a)

102null = snull typeInformation

101null = snull typeInformation

103

102

104

103

105−unsafeMapNullable :: IsMaybe b ~ 'False

104+unsafeMapNullable :: NotNull b

106 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)

105 => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)

107unsafeMapNullable f ma = nullify (f (unsafeUnnullify ma))

106unsafeMapNullable f ma = nullify (f (unsafeUnnullify ma))

108

107

109

108

110−unsafeLiftOpNullable :: IsMaybe c ~ 'False

109+unsafeLiftOpNullable :: NotNull c

111 => (Expr a -> Expr b -> Expr c)

110 => (Expr a -> Expr b -> Expr c)

112 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)

111 -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)

113unsafeLiftOpNullable f ma mb =

112unsafeLiftOpNullable f ma mb =

src/Rel8/Expr/Num.hs+7−7

@@ -15,21 +15,21 @@ import Prelude ()

15import Rel8.Expr ( Expr( Expr ) )

16import Rel8.Expr.Function ( function )

17import Rel8.Expr.Opaleye ( castExpr )

18−import Rel8.Schema.Nullability ( IsMaybe, Sql )

18+import Rel8.Schema.Nullability ( Homonullable, Sql )

19import Rel8.Type.Num ( DBFractional, DBIntegral, DBNum )

20

21

22−fromIntegral :: (Sql DBIntegral a, Sql DBNum b, IsMaybe a ~ IsMaybe b)

22+fromIntegral :: (Sql DBIntegral a, Sql DBNum b, Homonullable a b)

23 => Expr a -> Expr b

24fromIntegral (Expr a) = castExpr (Expr a)

25

26

27−realToFrac :: (Sql DBNum a, Sql DBFractional b, IsMaybe a ~ IsMaybe b)

27+realToFrac :: (Sql DBNum a, Sql DBFractional b, Homonullable a b)

28 => Expr a -> Expr b

29realToFrac (Expr a) = castExpr (Expr a)

30

31

32−ceiling :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)

32+ceiling :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)

33 => Expr a -> Expr b

34ceiling = function "CEILING"

35

@@ -42,16 +42,16 @@ mod :: Sql DBIntegral a => Expr a -> Expr a -> Expr a

42mod = function "MOD"

43

44

45−floor :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)

45+floor :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)

46 => Expr a -> Expr b

47floor = function "FLOOR"

48

49

50−round :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)

50+round :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)

51 => Expr a -> Expr b

52round = function "ROUND"

53

54

55−truncate :: (Sql DBFractional a, Sql DBIntegral b, IsMaybe a ~ IsMaybe b)

55+truncate :: (Sql DBFractional a, Sql DBIntegral b, Homonullable a b)

56 => Expr a -> Expr b

57truncate = function "TRUNC"

src/Rel8/Schema/HTable/Vectorize.hs+8−8

@@ -32,19 +32,19 @@ where

32-- base

33import Data.Kind ( Type )

34import Data.List.NonEmpty ( NonEmpty )

35−import Data.Type.Equality ( (:~:)( Refl ) )

36import Prelude

35import Prelude

37

36

38-- rel8

37-- rel8

39import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

38import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

39+import Rel8.Schema.Dict ( Dict( Dict ) )

40import qualified Rel8.Schema.Kind as K

41import Rel8.Schema.HTable

42 ( HTable

43 , hfield, htabulate, htabulateA, hspecs

44 )

45import Rel8.Schema.Nullability

46− ( IsMaybe

46+ ( Unnullify

47− , Unnullify

47+ , NotNull

48 , Nullability( NonNullable )

49 )

50import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

@@ -59,7 +59,7 @@ import GHC.Generics (Generic)

59

60

61class Vector list where

62− listIsn'tMaybe :: proxy a -> IsMaybe (list a) :~: 'False

62+ listNotNull :: proxy a -> Dict NotNull (list a)

63 vectorTypeInformation :: ()

64 => Nullability a

65 -> TypeInformation (Unnullify a)

@@ -67,12 +67,12 @@ class Vector list where

67

68

69instance Vector [] where

70− listIsn'tMaybe _ = Refl

70+ listNotNull _ = Dict

71 vectorTypeInformation = listTypeInformation

72

73

74instance Vector NonEmpty where

75− listIsn'tMaybe _ = Refl

75+ listNotNull _ = Dict

76 vectorTypeInformation = nonEmptyTypeInformation

77

78

@@ -90,8 +90,8 @@ type instance Eval (Vectorize list ('Spec labels necessity a)) = 'Spec labels ne

90

91instance Vector list => MapSpec (Vectorize list) where

92 mapInfo = \case

93− SSpec {..} -> case listIsn'tMaybe @list nullability of

93+ SSpec {..} -> case listNotNull @list nullability of

94− Refl -> SSpec

94+ Dict -> SSpec

95 { nullability = NonNullable

96 , info = vectorTypeInformation nullability info

97 , ..

src/Rel8/Schema/Nullability.hs+25−11

@@ -12,10 +12,12 @@

12{-# language UndecidableSuperClasses #-}

13

14module Rel8.Schema.Nullability

15− ( IsMaybe, Nullify, Unnullify

15+ ( Nullify, Unnullify

16+ , NotNull

17+ , Homonullable

16 , Nullability( Nullable, NonNullable )

18 , Nullability( Nullable, NonNullable )

17− , Sql

18 , HasNullability, nullabilization

19 , HasNullability, nullabilization

20+ , Sql

19 )

21 )

20where

22where

21

23

@@ -53,27 +55,39 @@ type Nullify :: Type -> Type

53type Nullify a = Maybe (Unnullify a)

55type Nullify a = Maybe (Unnullify a)

54

56

55

57

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+

56type Nullability :: Type -> Type

70type Nullability :: Type -> Type

57data Nullability a where

71data Nullability a where

58− NonNullable :: IsMaybe a ~ 'False => Nullability a

72+ NonNullable :: NotNull a => Nullability a

59− Nullable :: IsMaybe a ~ 'False => Nullability (Maybe a)

73+ Nullable :: NotNull a => Nullability (Maybe a)

60

74

61

75

62type HasNullability' :: Bool -> Type -> Constraint

76type HasNullability' :: Bool -> Type -> Constraint

63class

77class

64 ( IsMaybe a ~ isMaybe

78 ( IsMaybe a ~ isMaybe

65− , IsMaybe (Unnullify a) ~ 'False

79+ , NotNull (Unnullify a)

66 , Nullify' isMaybe (Unnullify a) ~ a

80 , Nullify' isMaybe (Unnullify a) ~ a

67 ) => HasNullability' isMaybe a

81 ) => HasNullability' isMaybe a

68 where

82 where

69 nullabilization' :: Nullability a

83 nullabilization' :: Nullability a

70

84

71

85

72−instance IsMaybe a ~ 'False => HasNullability' 'False a where

86+instance NotNull a => HasNullability' 'False a where

73 nullabilization' = NonNullable

87 nullabilization' = NonNullable

74

88

75

89

76−instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where

90+instance NotNull a => HasNullability' 'True (Maybe a) where

77 nullabilization' = Nullable

91 nullabilization' = Nullable

78

92

79

93

@@ -83,6 +97,10 @@ instance HasNullability' (IsMaybe a) a => HasNullability a

83instance {-# OVERLAPPING #-} HasNullability Opaque

97instance {-# OVERLAPPING #-} HasNullability Opaque

84

98

85

99

100+nullabilization :: HasNullability a => Nullability a

101+nullabilization = nullabilization'

102+

103+

86-- | The @Sql@ type class describes both null and not null database values,

104-- | The @Sql@ type class describes both null and not null database values,

87-- constrained by a specific class.

105-- constrained by a specific class.

88--

106--

@@ -98,7 +116,3 @@ class

98 => Sql constraint a

116 => Sql constraint a

99instance (constraint (Unnullify a), HasNullability a) => Sql constraint a

117instance (constraint (Unnullify a), HasNullability a) => Sql constraint a

100instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque

118instance {-# 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(..) )

47import Rel8.Schema.HTable.Pair ( HPair(..) )

48import Rel8.Schema.HTable.Trio ( HTrio(..) )

49import Rel8.Schema.HTable.Type ( HType(..) )

50−import Rel8.Schema.Nullability ( IsMaybe, Sql )

50+import Rel8.Schema.Nullability ( NotNull, Sql )

51import Rel8.Schema.Spec ( SSpec(..), KnownSpec )

52import Rel8.Table ( Table, Columns, fromColumns, toColumns )

53import Rel8.Table.Either ( EitherTable )

@@ -139,7 +139,7 @@ class (Table Expr exprs, isTabular ~ IsTabular a) =>

139

140instance

141 ( DBType a

142− , IsMaybe a ~ 'False

142+ , NotNull a

143 , IsTabular a ~ 'False

144 , x ~ Expr a

145 )

@@ -162,7 +162,7 @@ instance

162instance

163 ( Sql DBType a

164 , isTabular ~ 'False

165− , IsMaybe a ~ 'False

165+ , NotNull a

166 , IsMaybeTabular a ~ 'False

167 , x ~ Maybe a

168 ) => 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 )

36

37-- rel8

38import Rel8.Opaque ( Opaque )

39−import Rel8.Schema.Nullability ( Sql, nullabilization )

39+import Rel8.Schema.Nullability ( NotNull, Sql, nullabilization )

40import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )

41import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )

42

@@ -82,7 +82,7 @@ import qualified Data.UUID as UUID

82-- avoid making bad joins. However, when SQL is generated, it will be as if you

83-- just used integers (the type distinction does not impact query generation).

84type DBType :: Type -> Constraint

85−class DBType a where

85+class NotNull a => DBType a where

86 typeInformation :: TypeInformation a

87

88