8a680c9 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Reverse dependency between MaybeTable (and friends) and Serializable

8a680c9Shane O'Brien6 years ago

src/Rel8/Table/Either.hs+19−2

compare with master

unifiedsplit

@@ -11,6 +11,8 @@

11{-# language TypeFamilies #-}

12{-# language UndecidableInstances #-}

14+{-# options_ghc -fno-warn-orphans #-}

15+

14module Rel8.Table.Either

16module Rel8.Table.Either

15 ( EitherTable(..)

17 ( EitherTable(..)

16 , eitherTable, leftTable, rightTable

18 , eitherTable, leftTable, rightTable

@@ -55,6 +57,7 @@ import Rel8.Table.Bool ( bool )

55import Rel8.Table.Eq ( EqTable, eqTable )

57import Rel8.Table.Eq ( EqTable, eqTable )

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

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

57import Rel8.Table.Recontextualize ( Recontextualize )

59import Rel8.Table.Recontextualize ( Recontextualize )

60+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

58import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )

61import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )

59import Rel8.Table.Undefined ( undefined )

62import Rel8.Table.Undefined ( undefined )

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

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

@@ -121,8 +124,8 @@ instance

121 , Nullifiable to, Labelable to, ConstrainTag to EitherTag

124 , Nullifiable to, Labelable to, ConstrainTag to EitherTag

122 , Recontextualize from to a1 b1

125 , Recontextualize from to a1 b1

123 , Recontextualize from to a2 b2

126 , Recontextualize from to a2 b2

124− ) =>

127+ )

125− Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)

128+ => Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)

126

129

127

130

128instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where

131instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where

@@ -133,6 +136,20 @@ instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where

133 ordTable = toColumns2 id id (rightTableWith (ordTable @a) (ordTable @b))

136 ordTable = toColumns2 id id (rightTableWith (ordTable @a) (ordTable @b))

134

137

135

138

139+type instance FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)

140+

141+

142+instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>

143+ ToExprs x (Either a b)

144+ where

145+ fromResult =

146+ bimap (fromResult @exprs1) (fromResult @exprs2) .

147+ fromColumns

148+ toResult =

149+ toColumns .

150+ bimap (toResult @exprs1) (toResult @exprs2)

151+

152+

136isLeftTable :: EitherTable a b -> Expr Bool

153isLeftTable :: EitherTable a b -> Expr Bool

137isLeftTable = isLeft . expr . tag

154isLeftTable = isLeft . expr . tag

138

155

src/Rel8/Table/List.hs+9

@@ -41,6 +41,7 @@ import Rel8.Table.Alternative

41import Rel8.Table.Eq ( EqTable, eqTable )

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

43import Rel8.Table.Recontextualize ( Recontextualize )

44+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

44import Rel8.Table.Unreify ( Unreifiable )

45import Rel8.Table.Unreify ( Unreifiable )

@@ -90,6 +91,14 @@ instance OrdTable a => OrdTable (ListTable a) where

90 (Identity (ordTable @a))

91 (Identity (ordTable @a))

94+type instance FromExprs (ListTable a) = [FromExprs a]

95+

96+

97+instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where

98+ fromResult = fmap (fromResult @exprs) . fromColumns

99+ toResult = toColumns . fmap (toResult @exprs)

100+

101+

93instance AltTable ListTable where

102instance AltTable ListTable where

94 (<|>:) = (<>)

103 (<|>:) = (<>)

104

src/Rel8/Table/Maybe.hs+9

@@ -60,6 +60,7 @@ import Rel8.Table.Bool ( bool )

60import Rel8.Table.Eq ( EqTable, eqTable )

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

62import Rel8.Table.Recontextualize ( Recontextualize )

63+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

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

64import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )

64import Rel8.Table.Undefined ( undefined )

65import Rel8.Table.Undefined ( undefined )

65import Rel8.Type ( DBType )

66import Rel8.Type ( DBType )

@@ -162,6 +163,14 @@ instance OrdTable a => OrdTable (MaybeTable a) where

162 ordTable = toColumns1 id (justTable (ordTable @a))

163 ordTable = toColumns1 id (justTable (ordTable @a))

163

164

165

166+type instance FromExprs (MaybeTable a) = Maybe (FromExprs a)

167+

168+

169+instance ToExprs exprs a => ToExprs (MaybeTable exprs) (Maybe a) where

170+ fromResult = fmap (fromResult @exprs) . fromColumns

171+ toResult = toColumns . fmap (toResult @exprs)

172+

173+

165-- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.

174-- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.

166isNothingTable :: MaybeTable a -> Expr Bool

175isNothingTable :: MaybeTable a -> Expr Bool

167isNothingTable (MaybeTable tag _) = isNull (expr tag)

176isNothingTable (MaybeTable tag _) = isNull (expr tag)

src/Rel8/Table/NonEmpty.hs+10

@@ -41,6 +41,7 @@ import Rel8.Table.Alternative ( AltTable, (<|>:) )

41import Rel8.Table.Eq ( EqTable, eqTable )

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

43import Rel8.Table.Recontextualize ( Recontextualize )

44+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

44import Rel8.Table.Unreify ( Unreifiable )

45import Rel8.Table.Unreify ( Unreifiable )

@@ -91,6 +92,15 @@ instance OrdTable a => OrdTable (NonEmptyTable a) where

91 (Identity (ordTable @a))

92 (Identity (ordTable @a))

95+type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)

96+

97+

98+instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)

99+ where

100+ fromResult = fmap (fromResult @exprs) . fromColumns

101+ toResult = toColumns . fmap (toResult @exprs)

102+

103+

94instance AltTable NonEmptyTable where

104instance AltTable NonEmptyTable where

95 (<|>:) = (<>)

105 (<|>:) = (<>)

106

src/Rel8/Table/Serialize.hs−52

@@ -21,7 +21,6 @@ module Rel8.Table.Serialize

21where

23-- base

24−import Data.Bifunctor ( bimap )

25import Data.Kind ( Constraint, Type )

24import Data.Kind ( Constraint, Type )

26import Data.List.NonEmpty ( NonEmpty )

25import Data.List.NonEmpty ( NonEmpty )

27import GHC.Generics ( Generic, Rep, from, to )

26import GHC.Generics ( Generic, Rep, from, to )

@@ -46,19 +45,11 @@ import Rel8.Schema.Null ( NotNull, Sql )

46import Rel8.Schema.Result ( Col( Result ), Result )

45import Rel8.Schema.Result ( Col( Result ), Result )

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

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

48import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )

47import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )

49−import Rel8.Table.Either ( EitherTable )

50−import Rel8.Table.List ( ListTable )

51−import Rel8.Table.Maybe ( MaybeTable )

52−import Rel8.Table.NonEmpty ( NonEmptyTable )

53−import Rel8.Table.These ( TheseTable )

54import Rel8.Type ( DBType )

48import Rel8.Type ( DBType )

56-- semigroupoids

50-- semigroupoids

57import Data.Functor.Apply ( WrappedApplicative(..) )

51import Data.Functor.Apply ( WrappedApplicative(..) )

59−-- these

60−import Data.These ( These )

61−

63type ToExprs :: Type -> Type -> Constraint

54type ToExprs :: Type -> Type -> Constraint

64class Table Expr exprs => ToExprs exprs a where

55class Table Expr exprs => ToExprs exprs a where

@@ -126,44 +117,6 @@ instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty

126 toResult = HType . Result

117 toResult = HType . Result

127

118

128

119

129−instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>

130− ToExprs x (Either a b)

131− where

132− fromResult =

133− bimap (fromResult @exprs1) (fromResult @exprs2) .

134− fromColumns

135− toResult =

136− toColumns .

137− bimap (toResult @exprs1) (toResult @exprs2)

138−

139−

140−instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where

141− fromResult = fmap (fromResult @exprs) . fromColumns

142− toResult = toColumns . fmap (toResult @exprs)

143−

144−

145−instance ToExprs exprs a => ToExprs (MaybeTable exprs) (Maybe a) where

146− fromResult = fmap (fromResult @exprs) . fromColumns

147− toResult = toColumns . fmap (toResult @exprs)

148−

149−

150−instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)

151− where

152− fromResult = fmap (fromResult @exprs) . fromColumns

153− toResult = toColumns . fmap (toResult @exprs)

154−

155−

156−instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ TheseTable exprs1 exprs2) =>

157− ToExprs x (These a b)

158− where

159− fromResult =

160− bimap (fromResult @exprs1) (fromResult @exprs2) .

161− fromColumns

162− toResult =

163− toColumns .

164− bimap (toResult @exprs1) (toResult @exprs2)

165−

166−

167instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ (exprs1, exprs2)) =>

120instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ (exprs1, exprs2)) =>

168 ToExprs x (a, b)

121 ToExprs x (a, b)

169

122

@@ -241,11 +194,6 @@ type FromExprs :: Type -> Type

241type family FromExprs a

194type family FromExprs a

242type instance FromExprs (Expr a) = a

195type instance FromExprs (Expr a) = a

243type instance FromExprs (Col Expr spec) = Col Result spec

196type instance FromExprs (Col Expr spec) = Col Result spec

244−type instance FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)

245−type instance FromExprs (ListTable a) = [FromExprs a]

246−type instance FromExprs (MaybeTable a) = Maybe (FromExprs a)

247−type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)

248−type instance FromExprs (TheseTable a b) = These (FromExprs a) (FromExprs b)

249type instance FromExprs (a, b) = (FromExprs a, FromExprs b)

197type instance FromExprs (a, b) = (FromExprs a, FromExprs b)

250type instance FromExprs (a, b, c) = (FromExprs a, FromExprs b, FromExprs c)

198type instance FromExprs (a, b, c) = (FromExprs a, FromExprs b, FromExprs c)

251type instance FromExprs (a, b, c, d) =

199type instance FromExprs (a, b, c, d) =

src/Rel8/Table/These.hs+20

@@ -13,6 +13,8 @@

13{-# language TypeFamilies #-}

14{-# language UndecidableInstances #-}

16+{-# options_ghc -fno-warn-orphans #-}

17+

16module Rel8.Table.These

18module Rel8.Table.These

17 ( TheseTable(..)

19 ( TheseTable(..)

18 , theseTable, thisTable, thatTable, thoseTable

20 , theseTable, thisTable, thatTable, thoseTable

@@ -64,6 +66,7 @@ import Rel8.Table.Maybe

64 )

66 )

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

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

66import Rel8.Table.Recontextualize ( Recontextualize )

68import Rel8.Table.Recontextualize ( Recontextualize )

69+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

67import Rel8.Table.Tag ( Tag(..) )

70import Rel8.Table.Tag ( Tag(..) )

68import Rel8.Table.Undefined ( undefined )

71import Rel8.Table.Undefined ( undefined )

69import Rel8.Type.Tag ( MaybeTag )

72import Rel8.Type.Tag ( MaybeTag )

@@ -72,6 +75,9 @@ import Rel8.Type.Tag ( MaybeTag )

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

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

73import Data.Functor.Bind ( Bind, (>>-) )

76import Data.Functor.Bind ( Bind, (>>-) )

78+-- these

79+import Data.These ( These )

80+

76type TheseTable :: Type -> Type -> Type

82type TheseTable :: Type -> Type -> Type

77data TheseTable a b = TheseTable

83data TheseTable a b = TheseTable

@@ -153,6 +159,20 @@ instance (OrdTable a, OrdTable b) => OrdTable (TheseTable a b) where

153 ordTable = toColumns2 id id (thoseTable (ordTable @a) (ordTable @b))

159 ordTable = toColumns2 id id (thoseTable (ordTable @a) (ordTable @b))

154

160

155

161

162+type instance FromExprs (TheseTable a b) = These (FromExprs a) (FromExprs b)

163+

164+

165+instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ TheseTable exprs1 exprs2) =>

166+ ToExprs x (These a b)

167+ where

168+ fromResult =

169+ bimap (fromResult @exprs1) (fromResult @exprs2) .

170+ fromColumns

171+ toResult =

172+ toColumns .

173+ bimap (toResult @exprs1) (toResult @exprs2)

174+

175+

156toHereTag :: Tag "isJust" a -> Tag "hasHere" a

176toHereTag :: Tag "isJust" a -> Tag "hasHere" a

157toHereTag Tag {..} = Tag {..}

177toHereTag Tag {..} = Tag {..}

158

178