b135026 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

We don't need the Identity instance for Taggable, dropping it simplifies things

b135026Shane O'Brien6 years ago

src/Rel8/Schema/Context/Nullify.hs+16−50

compare with master

unifiedsplit

@@ -13,13 +13,12 @@

13module Rel8.Schema.Context.Nullify

14 ( Nullifiable( ConstrainTag, encodeTag, decodeTag, nullifier, unnullifier )

15 , HNullifiable( HConstrainTag, hencodeTag, hdecodeTag, hnullifier, hunnullifier )

16− , runTag, runTagExpr, unnull, unnullExpr

16+ , runTag, unnull

17 )

18where

20-- base

21import Control.Monad ( guard )

22−import Data.Functor.Identity ( Identity )

23import Data.Kind ( Constraint, Type )

22import Data.Kind ( Constraint, Type )

24import GHC.TypeLits ( KnownSymbol )

23import GHC.TypeLits ( KnownSymbol )

25import Prelude hiding ( null )

24import Prelude hiding ( null )

@@ -38,7 +37,7 @@ import Rel8.Expr.Bool ( boolExpr )

38import Rel8.Expr.Null ( nullify, unsafeUnnullify )

37import Rel8.Expr.Null ( nullify, unsafeUnnullify )

39import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

38import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

40import Rel8.Kind.Necessity ( Necessity( Required ) )

39import Rel8.Kind.Necessity ( Necessity( Required ) )

41−import Rel8.Schema.Context ( Interpretation, Col(..) )

40+import Rel8.Schema.Context ( Interpretation )

42import qualified Rel8.Schema.Kind as K

41import qualified Rel8.Schema.Kind as K

43import Rel8.Schema.Name ( Name( Name ), Col(..) )

42import Rel8.Schema.Name ( Name( Name ), Col(..) )

44import Rel8.Schema.Nullability

43import Rel8.Schema.Nullability

@@ -52,10 +51,7 @@ import Rel8.Schema.Spec.ConstrainDBType

52 ( ConstrainDBType

51 ( ConstrainDBType

53 , dbTypeDict, dbTypeNullability, fromNullabilityDict

52 , dbTypeDict, dbTypeNullability, fromNullabilityDict

54 )

53 )

55−import Rel8.Table.Tag

56− ( Tag(..), Taggable

57− , fromAggregate, fromExpr, fromIdentity, fromName

54+import Rel8.Table.Tag ( Tag(..), Taggable, fromAggregate, fromExpr, fromName )

58− )

61type Nullifiable :: K.Context -> Constraint

57type Nullifiable :: K.Context -> Constraint

@@ -81,7 +77,6 @@ class Interpretation context => Nullifiable context where

82 nullifier :: ()

78 nullifier :: ()

83 => Tag label a

79 => Tag label a

84− -> (a -> Bool)

85 -> (Expr a -> Expr Bool)

80 -> (Expr a -> Expr Bool)

86 -> SSpec ('Spec labels necessity x)

81 -> SSpec ('Spec labels necessity x)

87 -> Col context ('Spec labels necessity x)

82 -> Col context ('Spec labels necessity x)

@@ -99,15 +94,15 @@ instance Nullifiable Aggregate where

100 decodeTag (Aggregation aggregate) = fromAggregate aggregate

95 decodeTag (Aggregation aggregate) = fromAggregate aggregate

101

102− nullifier Tag {expr} _ test SSpec {nullability} (Aggregation aggregate) =

97+ nullifier Tag {expr} test SSpec {nullability} (Aggregation aggregate) =

103 Aggregation $

98 Aggregation $

104− mapInputs (toPrimExpr . runTagExpr nullability condition . fromPrimExpr) $

99+ mapInputs (toPrimExpr . runTag nullability condition . fromPrimExpr) $

105− runTagExpr nullability condition <$> aggregate

100+ runTag nullability condition <$> aggregate

106 where

101 where

107 condition = test expr

102 condition = test expr

108

103

109 unnullifier SSpec {nullability} (Aggregation aggregate) =

104 unnullifier SSpec {nullability} (Aggregation aggregate) =

110− Aggregation $ unnullExpr nullability <$> aggregate

105+ Aggregation $ unnull nullability <$> aggregate

111

106

112 {-# INLINABLE encodeTag #-}

107 {-# INLINABLE encodeTag #-}

113 {-# INLINABLE decodeTag #-}

108 {-# INLINABLE decodeTag #-}

@@ -118,22 +113,9 @@ instance Nullifiable Aggregate where

118instance Nullifiable Expr where

113instance Nullifiable Expr where

119 encodeTag Tag {expr} = DB expr

114 encodeTag Tag {expr} = DB expr

120 decodeTag (DB a) = fromExpr a

115 decodeTag (DB a) = fromExpr a

121− nullifier Tag {expr} _ test SSpec {nullability} (DB a) =

116+ nullifier Tag {expr} test SSpec {nullability} (DB a) =

122− DB $ runTagExpr nullability (test expr) a

123− unnullifier SSpec {nullability} (DB a) = DB $ unnullExpr nullability a

124−

125− {-# INLINABLE encodeTag #-}

126− {-# INLINABLE decodeTag #-}

127− {-# INLINABLE nullifier #-}

128− {-# INLINABLE unnullifier #-}

129−

130−

131−instance Nullifiable Identity where

132− encodeTag Tag {identity} = Result identity

133− decodeTag (Result a) = fromIdentity a

134− nullifier Tag {identity} test _ SSpec {nullability} (Result a) =

135− Result $ runTag nullability (test identity) a

117+ DB $ runTag nullability (test expr) a

136− unnullifier SSpec {nullability} (Result a) = Result $ unnull nullability a

118+ unnullifier SSpec {nullability} (DB a) = DB $ unnull nullability a

137

119

138 {-# INLINABLE encodeTag #-}

120 {-# INLINABLE encodeTag #-}

139 {-# INLINABLE decodeTag #-}

121 {-# INLINABLE decodeTag #-}

@@ -144,7 +126,7 @@ instance Nullifiable Identity where

144instance Nullifiable Name where

126instance Nullifiable Name where

145 encodeTag Tag {name = Name name} = NameCol name

127 encodeTag Tag {name = Name name} = NameCol name

146 decodeTag (NameCol name) = fromName (Name name)

128 decodeTag (NameCol name) = fromName (Name name)

147− nullifier _ _ _ _ (NameCol name) = NameCol name

129+ nullifier _ _ _ (NameCol name) = NameCol name

148 unnullifier _ (NameCol name) = NameCol name

130 unnullifier _ (NameCol name) = NameCol name

149

131

150 {-# INLINABLE encodeTag #-}

132 {-# INLINABLE encodeTag #-}

@@ -153,35 +135,20 @@ instance Nullifiable Name where

153 {-# INLINABLE unnullifier #-}

135 {-# INLINABLE unnullifier #-}

154

136

155

137

156−runTagExpr :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)

138+runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)

157−runTagExpr nullability tag a = case nullability of

139+runTag nullability tag a = case nullability of

158 Nullable -> boolExpr null a tag

140 Nullable -> boolExpr null a tag

159 NonNullable -> boolExpr null (nullify a) tag

141 NonNullable -> boolExpr null (nullify a) tag

160 where

142 where

161 null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit

143 null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit

162

144

163

145

164−unnullExpr :: Nullability a -> Expr (Nullify a) -> Expr a

146+unnull :: Nullability a -> Expr (Nullify a) -> Expr a

165−unnullExpr nullability a = case nullability of

147+unnull nullability a = case nullability of

166 Nullable -> a

148 Nullable -> a

167 NonNullable -> unsafeUnnullify a

149 NonNullable -> unsafeUnnullify a

168

150

169

151

170−runTag :: Nullability a -> Bool -> a -> Nullify a

171−runTag nullability tag a = case nullability of

172− Nullable -> a <* guard tag

173− NonNullable -> a <$ guard tag

174−

175−

176−unnull :: Nullability a -> Nullify a -> a

177−unnull nullability ma = case nullability of

178− Nullable -> ma

179− NonNullable -> case ma of

180− Just a -> a

181− Nothing ->

182− error "Rel8.Schema.Context.Nullify.unnull: mismatch between tag and data"

183−

184−

185type HNullifiable :: K.HContext -> Constraint

152type HNullifiable :: K.HContext -> Constraint

186class HNullifiable context where

153class HNullifiable context where

187 type HConstrainTag context :: Type -> Constraint

154 type HConstrainTag context :: Type -> Constraint

@@ -197,7 +164,6 @@ class HNullifiable context where

197

164

198 hnullifier :: ()

165 hnullifier :: ()

199 => Tag label a

166 => Tag label a

200− -> (a -> Bool)

201 -> (Expr a -> Expr Bool)

167 -> (Expr a -> Expr Bool)

202 -> SSpec ('Spec labels necessity x)

168 -> SSpec ('Spec labels necessity x)

203 -> context ('Spec labels necessity x)

169 -> context ('Spec labels necessity x)

@@ -223,7 +189,7 @@ instance HNullifiable (Dict (ConstrainDBType constraint)) where

223 hencodeTag _ = Dict

189 hencodeTag _ = Dict

224 hdecodeTag = mempty

190 hdecodeTag = mempty

225

191

226− hnullifier _ _ _ SSpec {} dict = case dbTypeDict dict of

192+ hnullifier _ _ SSpec {} dict = case dbTypeDict dict of

227 Dict -> case dbTypeNullability dict of

193 Dict -> case dbTypeNullability dict of

228 Nullable -> Dict

194 Nullable -> Dict

229 NonNullable -> Dict

195 NonNullable -> Dict

src/Rel8/Schema/Insert.hs+6−6

@@ -36,7 +36,7 @@ import Rel8.Schema.Context ( Interpretation(..) )

36import Rel8.Schema.Context.Label ( Labelable(..) )

37import Rel8.Schema.Context.Nullify

38 ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier

39− , runTagExpr, unnullExpr

39+ , runTag, unnull

40 )

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

42import qualified Rel8.Schema.Kind as K

@@ -138,17 +138,17 @@ instance Nullifiable Insert where

138 encodeTag = RequiredInsert . expr

139 decodeTag (RequiredInsert a) = fromExpr a

140

141− nullifier Tag {expr} _ test SSpec {nullability} = \case

141+ nullifier Tag {expr} test SSpec {nullability} = \case

142 RequiredInsert a ->

143− RequiredInsert $ runTagExpr nullability condition a

143+ RequiredInsert $ runTag nullability condition a

144 OptionalInsert ma ->

145− OptionalInsert $ runTagExpr nullability condition <$> ma

145+ OptionalInsert $ runTag nullability condition <$> ma

146 where

147 condition = test expr

148

149 unnullifier SSpec {nullability} = \case

150− RequiredInsert a -> RequiredInsert $ unnullExpr nullability a

150+ RequiredInsert a -> RequiredInsert $ unnull nullability a

151− OptionalInsert ma -> OptionalInsert $ unnullExpr nullability <$> ma

151+ OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma

152

153 {-# INLINABLE encodeTag #-}

154 {-# INLINABLE decodeTag #-}

src/Rel8/Table/Either.hs+6−5

@@ -29,6 +29,7 @@ import Prelude hiding ( undefined )

29import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

30import Rel8.Expr ( Expr )

31import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

32+import Rel8.Expr.Serialize ( litExpr )

32import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )

33import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )

33import Rel8.Schema.Context.Nullify

34import Rel8.Schema.Context.Nullify

34 ( Nullifiable, ConstrainTag

35 ( Nullifiable, ConstrainTag

@@ -48,7 +49,7 @@ import Rel8.Table.Lifted

48 )

49 )

49import Rel8.Table.Ord ( OrdTable, ordTable )

50import Rel8.Table.Ord ( OrdTable, ordTable )

50import Rel8.Table.Recontextualize ( Recontextualize )

51import Rel8.Table.Recontextualize ( Recontextualize )

51−import Rel8.Table.Tag ( Tag(..), fromIdentity, fromName )

52+import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )

52import Rel8.Table.Undefined ( undefined )

53import Rel8.Table.Undefined ( undefined )

53import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

54import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

@@ -100,8 +101,8 @@ instance Table2 EitherTable where

100

101

101 toColumns2 f g EitherTable {tag, left, right} = HEitherTable

102 toColumns2 f g EitherTable {tag, left, right} = HEitherTable

102 { htag

103 { htag

103− , hleft = hnullify (hnullifier tag (== IsLeft) isLeft) $ f left

104+ , hleft = hnullify (hnullifier tag isLeft) $ f left

104− , hright = hnullify (hnullifier tag (== IsRight) isRight) $ g right

105+ , hright = hnullify (hnullifier tag isRight) $ g right

105 }

106 }

106 where

107 where

107 htag = HIdentity (hencodeTag tag)

108 htag = HIdentity (hencodeTag tag)

@@ -177,7 +178,7 @@ eitherTable f g EitherTable {tag, left, right} =

177

178

179

179leftTable :: Table Expr b => a -> EitherTable a b

180leftTable :: Table Expr b => a -> EitherTable a b

180−leftTable a = EitherTable (fromIdentity IsLeft) a undefined

181+leftTable a = EitherTable (fromExpr (litExpr IsLeft)) a undefined

181

182

183

183rightTable :: Table Expr a => b -> EitherTable a b

184rightTable :: Table Expr a => b -> EitherTable a b

@@ -185,7 +186,7 @@ rightTable = rightTableWith undefined

185

186

187

187rightTableWith :: a -> b -> EitherTable a b

188rightTableWith :: a -> b -> EitherTable a b

188−rightTableWith = EitherTable (fromIdentity IsRight)

189+rightTableWith = EitherTable (fromExpr (litExpr IsRight))

189

190

191

191aggregateEitherTable :: ()

192aggregateEitherTable :: ()

src/Rel8/Table/Maybe.hs+5−9

@@ -22,10 +22,8 @@ module Rel8.Table.Maybe

22where

24-- base

25−import qualified Data.Bool as Bool

26import Data.Functor.Identity ( runIdentity )

25import Data.Functor.Identity ( runIdentity )

27import Data.Kind ( Type )

26import Data.Kind ( Type )

28−import Data.Maybe ( isJust, isNothing )

29import Prelude hiding ( null, repeat, undefined, zipWith )

27import Prelude hiding ( null, repeat, undefined, zipWith )

31-- rel8

29-- rel8

@@ -62,10 +60,10 @@ import Rel8.Table.Lifted

62 )

60 )

63import Rel8.Table.Ord ( OrdTable, ordTable )

61import Rel8.Table.Ord ( OrdTable, ordTable )

64import Rel8.Table.Recontextualize ( Recontextualize )

62import Rel8.Table.Recontextualize ( Recontextualize )

65−import Rel8.Table.Tag ( Tag(..), fromIdentity, fromName )

63+import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )

66import Rel8.Table.Undefined ( undefined )

64import Rel8.Table.Undefined ( undefined )

67import Rel8.Type ( DBType )

65import Rel8.Type ( DBType )

68−import Rel8.Type.Tag ( MaybeTag( IsJust ) )

66+import Rel8.Type.Tag ( MaybeTag )

70-- semigroupoids

68-- semigroupoids

71import Data.Functor.Apply ( Apply, (<.>), liftF2 )

69import Data.Functor.Apply ( Apply, (<.>), liftF2 )

@@ -114,8 +112,6 @@ instance AltTable MaybeTable where

114 ma@(MaybeTable tag a) <|>: MaybeTable tag' b = MaybeTable

112 ma@(MaybeTable tag a) <|>: MaybeTable tag' b = MaybeTable

115 { tag = (tag <> tag')

113 { tag = (tag <> tag')

116 { expr = boolExpr (expr tag) (expr tag') condition

114 { expr = boolExpr (expr tag) (expr tag') condition

117− , identity =

118− Bool.bool (identity tag) (identity tag') (isNothing (identity tag))

119 }

115 }

120 , just = bool a b condition

116 , just = bool a b condition

121 }

117 }

@@ -141,7 +137,7 @@ instance Table1 MaybeTable where

141

137

142 toColumns1 f MaybeTable {tag, just} = HMaybeTable

138 toColumns1 f MaybeTable {tag, just} = HMaybeTable

143 { htag

139 { htag

144− , hjust = hnullify (hnullifier tag isJust isNonNull) $ f just

140+ , hjust = hnullify (hnullifier tag isNonNull) $ f just

145 }

141 }

146 where

142 where

147 htag = HIdentity (hencodeTag tag)

143 htag = HIdentity (hencodeTag tag)

@@ -203,13 +199,13 @@ maybeTable b f ma@(MaybeTable _ a) = bool (f a) b (isNothingTable ma)

203

199

204-- | The null table. Like 'Nothing'.

200-- | The null table. Like 'Nothing'.

205nothingTable :: Table Expr a => MaybeTable a

201nothingTable :: Table Expr a => MaybeTable a

206−nothingTable = MaybeTable (fromIdentity Nothing) undefined

202+nothingTable = MaybeTable (fromExpr null) undefined

207

203

208

204

209-- | Lift any table into 'MaybeTable'. Like 'Just'. Note you can also use

205-- | Lift any table into 'MaybeTable'. Like 'Just'. Note you can also use

210-- 'pure'.

206-- 'pure'.

211justTable :: a -> MaybeTable a

207justTable :: a -> MaybeTable a

212−justTable = MaybeTable (fromIdentity (Just IsJust))

208+justTable = MaybeTable (fromExpr mempty)

213

209

214

210

215-- | Project a single expression out of a 'MaybeTable'. You can think of this

211-- | Project a single expression out of a 'MaybeTable'. You can think of this

src/Rel8/Table/Tag.hs+5−41

@@ -1,5 +1,4 @@

1{-# language DataKinds #-}

2−{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

2{-# language FlexibleInstances #-}

4{-# language GADTs #-}

3{-# language GADTs #-}

5{-# language InstanceSigs #-}

4{-# language InstanceSigs #-}

@@ -13,14 +12,13 @@ module Rel8.Table.Tag

13 ( Tag(..), Taggable

12 ( Tag(..), Taggable

14 , fromAggregate

13 , fromAggregate

15 , fromExpr

14 , fromExpr

16− , fromIdentity

17 , fromName

15 , fromName

18 )

16 )

19where

17where

21-- base

19-- base

22−import Control.Applicative ( (<|>), empty, liftA2 )

20+import Control.Applicative ( (<|>), empty )

23−import Data.Kind ( Type )

21+import Data.Kind ( Constraint, Type )

24import Data.Foldable ( fold )

22import Data.Foldable ( fold )

25import Data.Monoid ( getFirst )

23import Data.Monoid ( getFirst )

26import Data.Proxy ( Proxy( Proxy ) )

24import Data.Proxy ( Proxy( Proxy ) )

@@ -31,14 +29,9 @@ import Prelude

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

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

32import Rel8.Expr ( Expr )

30import Rel8.Expr ( Expr )

33import Rel8.Expr.Opaleye ( fromPrimExpr )

31import Rel8.Expr.Opaleye ( fromPrimExpr )

34−import Rel8.Expr.Serialize ( litExpr )

35import Rel8.Schema.Dict ( Dict( Dict ) )

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

36import Rel8.Schema.Name ( Name( Name ) )

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

37−import Rel8.Schema.Nullability

34+import Rel8.Schema.Nullability ( Sql, mapSql )

38− ( Nullability( Nullable, NonNullable )

39− , Sql, nullabilization, mapSql

40− )

41−import Rel8.Type ( DBType )

42import Rel8.Type.Monoid ( DBMonoid )

35import Rel8.Type.Monoid ( DBMonoid )

43import Rel8.Type.Semigroup ( DBSemigroup )

36import Rel8.Type.Semigroup ( DBSemigroup )

@@ -47,28 +40,23 @@ type Tag :: Symbol -> Type -> Type

47data Tag label a = Tag

40data Tag label a = Tag

48 { expr :: Expr a

41 { expr :: Expr a

49 , aggregator :: Maybe Aggregator

42 , aggregator :: Maybe Aggregator

50− , identity :: a

51 , name :: Name a

43 , name :: Name a

52 }

44 }

47+type Taggable :: Type -> Constraint

55class Taggable a where

48class Taggable a where

56 tappend :: KnownSymbol label => Tag label a -> Tag label a -> Tag label a

49 tappend :: KnownSymbol label => Tag label a -> Tag label a -> Tag label a

57 tempty :: KnownSymbol label => Tag label a

50 tempty :: KnownSymbol label => Tag label a

58− tlit :: a -> Expr a

61−instance (Sql Monoid a, Sql DBMonoid a) => Taggable a where

53+instance Sql DBMonoid a => Taggable a where

62 tappend :: forall label. KnownSymbol label

54 tappend :: forall label. KnownSymbol label

63 => Tag label a -> Tag label a -> Tag label a

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

64 tappend a b = Tag

56 tappend a b = Tag

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

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

66 Dict -> expr a <> expr b

58 Dict -> expr a <> expr b

67 , aggregator = aggregator a <|> aggregator b

59 , aggregator = aggregator a <|> aggregator b

68− , identity = case mapSql semigroupFromMonoid (Dict @_ @a) of

69− Dict -> case nullabilization @a of

70− Nullable -> liftA2 (<>) (identity a) (identity b)

71− NonNullable -> identity a <> identity b

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

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

73 (Name x, y)

61 (Name x, y)

74 | x == y -> name b

62 | x == y -> name b

@@ -79,17 +67,9 @@ instance (Sql Monoid a, Sql DBMonoid a) => Taggable a where

79 tempty = Tag

67 tempty = Tag

80 { expr = mempty

68 { expr = mempty

81 , aggregator = empty

69 , aggregator = empty

82− , identity = case nullabilization @a of

83− Nullable -> Just mempty

84− NonNullable -> mempty

85 , name = Name (symbolVal (Proxy @label))

70 , name = Name (symbolVal (Proxy @label))

86 }

71 }

88− tlit = case mapSql (dbTypeFromDBSemigroup . dbSemigroupFromDBMonoid) dict of

89− Dict -> litExpr

90− where

91− dict = Dict @_ @a

92−

94instance (KnownSymbol label, Taggable a) => Semigroup (Tag label a) where

74instance (KnownSymbol label, Taggable a) => Semigroup (Tag label a) where

95 (<>) = tappend

75 (<>) = tappend

@@ -114,25 +94,9 @@ fromExpr :: forall label a. (KnownSymbol label, Taggable a)

114fromExpr expr = (tempty @a @label) {expr}

94fromExpr expr = (tempty @a @label) {expr}

115

116

117−fromIdentity :: forall a label. (KnownSymbol label, Taggable a)

118− => a -> Tag label a

119−fromIdentity identity = (mempty @(Tag label a))

120− { expr = tlit identity

121− , identity

122− }

123−

124−

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

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

126fromName name = (mempty @(Tag "" a)) {name}

98fromName name = (mempty @(Tag "" a)) {name}

127

128

100

129−dbTypeFromDBSemigroup :: Dict DBSemigroup a -> Dict DBType a

130−dbTypeFromDBSemigroup Dict = Dict

131−

132−

133dbSemigroupFromDBMonoid :: Dict DBMonoid a -> Dict DBSemigroup a

101dbSemigroupFromDBMonoid :: Dict DBMonoid a -> Dict DBSemigroup a

134dbSemigroupFromDBMonoid Dict = Dict

102dbSemigroupFromDBMonoid Dict = Dict

135−

136−

137−semigroupFromMonoid :: Dict Monoid a -> Dict Semigroup a

138−semigroupFromMonoid Dict = Dict

src/Rel8/Table/These.hs+2−3

@@ -27,7 +27,6 @@ where

27import Data.Bifunctor ( Bifunctor, bimap )

28import Data.Functor.Identity ( runIdentity )

29import Data.Kind ( Type )

30−import Data.Maybe ( isJust )

31import Prelude hiding ( undefined )

30import Prelude hiding ( undefined )

33-- rel8

32-- rel8

@@ -125,10 +124,10 @@ instance Table2 TheseTable where

125 toColumns2 f g TheseTable {here, there} = HTheseTable

124 toColumns2 f g TheseTable {here, there} = HTheseTable

126 { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))

125 { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))

127 , hhere =

126 , hhere =

128− hnullify (hnullifier (tag here) isJust isNonNull) $ f (just here)

127+ hnullify (hnullifier (tag here) isNonNull) $ f (just here)

129 , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))

128 , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))

130 , hthere =

129 , hthere =

131− hnullify (hnullifier (tag there) isJust isNonNull) $ g (just there)

130+ hnullify (hnullifier (tag there) isNonNull) $ g (just there)

132 }

131 }

133

132

134 fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =

133 fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =