4e90af3 · rel8 · git.iko.soy

src/Rel8/Schema/Null.hs+1−22

compare with master

unifiedsplit

@@ -16,7 +16,7 @@ module Rel8.Schema.Null

16 , Homonullable

17 , Nullity( Null, NotNull )

18 , Nullable, nullable

19− , Sql, fromSql, mapSql, toSql

19+ , Sql

20 )

21where

22

@@ -24,9 +24,6 @@ where

24import Data.Kind ( Constraint, Type )

25import Prelude

26

27−-- rel8

28−import Rel8.Schema.Dict ( Dict( Dict ) )

29−

30

27

31type IsMaybe :: Type -> Bool

28type IsMaybe :: Type -> Bool

32type family IsMaybe a where

29type family IsMaybe a where

@@ -111,21 +108,3 @@ nullable = nullable'

111type Sql :: (Type -> Constraint) -> Type -> Constraint

108type Sql :: (Type -> Constraint) -> Type -> Constraint

112class (constraint (Unnullify a), Nullable a) => Sql constraint a

109class (constraint (Unnullify a), Nullable a) => Sql constraint a

113instance (constraint (Unnullify a), Nullable a) => Sql constraint a

110instance (constraint (Unnullify a), Nullable a) => Sql constraint a

114−

115−

116−fromSql :: Dict (Sql constraint) a -> (Nullity a, Dict constraint (Unnullify a))

117−fromSql Dict = (nullable, Dict)

118−{-# INLINABLE fromSql #-}

119−

120−

121−mapSql :: ()

122− => (forall x. Dict constraint x -> Dict constraint' x)

123− -> Dict (Sql constraint) a -> Dict (Sql constraint') a

124−mapSql f dict = case fromSql dict of

125− (nullity, dict') -> toSql nullity (f dict')

126−

127−

128−toSql :: Nullity a -> Dict constraint (Unnullify a) -> Dict (Sql constraint) a

129−toSql NotNull Dict = Dict

130−toSql Null Dict = Dict

131−{-# INLINABLE toSql #-}

src/Rel8/Schema/Spec/ConstrainDBType.hs+3−5

@@ -21,7 +21,7 @@ import Prelude

21

22-- rel8

23import Rel8.Schema.Dict ( Dict( Dict ) )

24−import Rel8.Schema.Null ( Unnullify, Nullity, Sql, nullable, toSql )

24+import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )

25import Rel8.Schema.Spec ( Spec( Spec ) )

26

27

@@ -60,7 +60,5 @@ dbTypeDict = step2 . step1

60

61

62fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)

63−fromNullityDict nullity = step2 . toSql nullity

63+fromNullityDict Null Dict = Dict

64− where

64+fromNullityDict NotNull Dict = Dict

65− step2 :: Dict (Sql c) a -> Dict (ConstrainDBType c) ('Spec l n a)

66− step2 Dict = Dict

src/Rel8/Table/Tag.hs+2−9

@@ -29,11 +29,9 @@ import Prelude

29import Rel8.Aggregate ( Aggregate, Aggregator, foldInputs )

30import Rel8.Expr ( Expr )

31import Rel8.Expr.Opaleye ( fromPrimExpr )

32−import Rel8.Schema.Dict ( Dict( Dict ) )

33import Rel8.Schema.Name ( Name( Name ) )

32import Rel8.Schema.Name ( Name( Name ) )

34−import Rel8.Schema.Null ( Sql, mapSql )

33+import Rel8.Schema.Null ( Sql )

35import Rel8.Type.Monoid ( DBMonoid )

34import Rel8.Type.Monoid ( DBMonoid )

36−import Rel8.Type.Semigroup ( DBSemigroup )

37

35

38

36

39type Tag :: Symbol -> Type -> Type

37type Tag :: Symbol -> Type -> Type

@@ -54,8 +52,7 @@ instance Sql DBMonoid a => Taggable a where

54 tappend :: forall label. KnownSymbol label

52 tappend :: forall label. KnownSymbol label

55 => Tag label a -> Tag label a -> Tag label a

53 => Tag label a -> Tag label a -> Tag label a

56 tappend a b = Tag

54 tappend a b = Tag

57− { expr = case mapSql dbSemigroupFromDBMonoid (Dict @_ @a) of

58− Dict -> expr a <> expr b

55+ { expr = expr a <> expr b

59 , aggregator = aggregator a <|> aggregator b

56 , aggregator = aggregator a <|> aggregator b

60 , name = case (name a, symbolVal (Proxy @label)) of

57 , name = case (name a, symbolVal (Proxy @label)) of

61 (Name x, y)

58 (Name x, y)

@@ -98,7 +95,3 @@ fromExpr expr = (tempty @a @label) {expr}

98

95

99fromName :: forall a label. Taggable a => Name a -> Tag label a

96fromName :: forall a label. Taggable a => Name a -> Tag label a

100fromName name = (tempty @a @"") {name}

97fromName name = (tempty @a @"") {name}

101−

102−

103−dbSemigroupFromDBMonoid :: Dict DBMonoid a -> Dict DBSemigroup a

104−dbSemigroupFromDBMonoid Dict = Dict