git.iko.soy/rel8
on master help sign in
Reverse dependency between MaybeTable (and friends) and Serializable
commit8a680c99c3d2168e9895c866a0550f34c01bf53e authorShane O'Brien <shane.obrien@circuithub.com> dateWed 5 May 2021, 02:38 (6 years ago) parent45f6f2b
6 files changed+67−54
compare with master
unifiedsplit
src/Rel8/Table/Either.hs+19−2 src/Rel8/Table/List.hs+9 src/Rel8/Table/Maybe.hs+9 src/Rel8/Table/NonEmpty.hs+10 src/Rel8/Table/Serialize.hs−52 src/Rel8/Table/These.hs+20
src/Rel8/Table/Either.hs+19−2
@@ -11,6 +11,8 @@
1111{-# language TypeFamilies #-}
1212{-# language UndecidableInstances #-}
1313
14+{-# options_ghc -fno-warn-orphans #-}
15+
1416module Rel8.Table.Either
1517 ( EitherTable(..)
1618 , eitherTable, leftTable, rightTable
@@ -55,6 +57,7 @@ import Rel8.Table.Bool ( bool )
5557import Rel8.Table.Eq ( EqTable, eqTable )
5658import Rel8.Table.Ord ( OrdTable, ordTable )
5759import Rel8.Table.Recontextualize ( Recontextualize )
60+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
5861import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
5962import Rel8.Table.Undefined ( undefined )
6063import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )
@@ -121,8 +124,8 @@ instance
121124 , Nullifiable to, Labelable to, ConstrainTag to EitherTag
122125 , Recontextualize from to a1 b1
123126 , Recontextualize from to a2 b2
124− ) =>
125− Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)
127+ )
128+ => Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)
126129
127130
128131instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where
@@ -133,6 +136,20 @@ instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where
133136 ordTable = toColumns2 id id (rightTableWith (ordTable @a) (ordTable @b))
134137
135138
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+
136153isLeftTable :: EitherTable a b -> Expr Bool
137154isLeftTable = isLeft . expr . tag
138155
src/Rel8/Table/List.hs+9
@@ -41,6 +41,7 @@ import Rel8.Table.Alternative
4141import Rel8.Table.Eq ( EqTable, eqTable )
4242import Rel8.Table.Ord ( OrdTable, ordTable )
4343import Rel8.Table.Recontextualize ( Recontextualize )
44+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
4445import Rel8.Table.Unreify ( Unreifiable )
4546
4647
@@ -90,6 +91,14 @@ instance OrdTable a => OrdTable (ListTable a) where
9091 (Identity (ordTable @a))
9192
9293
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+
93102instance AltTable ListTable where
94103 (<|>:) = (<>)
95104
src/Rel8/Table/Maybe.hs+9
@@ -60,6 +60,7 @@ import Rel8.Table.Bool ( bool )
6060import Rel8.Table.Eq ( EqTable, eqTable )
6161import Rel8.Table.Ord ( OrdTable, ordTable )
6262import Rel8.Table.Recontextualize ( Recontextualize )
63+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
6364import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
6465import Rel8.Table.Undefined ( undefined )
6566import Rel8.Type ( DBType )
@@ -162,6 +163,14 @@ instance OrdTable a => OrdTable (MaybeTable a) where
162163 ordTable = toColumns1 id (justTable (ordTable @a))
163164
164165
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+
165174-- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.
166175isNothingTable :: MaybeTable a -> Expr Bool
167176isNothingTable (MaybeTable tag _) = isNull (expr tag)
src/Rel8/Table/NonEmpty.hs+10
@@ -41,6 +41,7 @@ import Rel8.Table.Alternative ( AltTable, (<|>:) )
4141import Rel8.Table.Eq ( EqTable, eqTable )
4242import Rel8.Table.Ord ( OrdTable, ordTable )
4343import Rel8.Table.Recontextualize ( Recontextualize )
44+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
4445import Rel8.Table.Unreify ( Unreifiable )
4546
4647
@@ -91,6 +92,15 @@ instance OrdTable a => OrdTable (NonEmptyTable a) where
9192 (Identity (ordTable @a))
9293
9394
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+
94104instance AltTable NonEmptyTable where
95105 (<|>:) = (<>)
96106
src/Rel8/Table/Serialize.hs−52
@@ -21,7 +21,6 @@ module Rel8.Table.Serialize
2121where
2222
2323-- base
24−import Data.Bifunctor ( bimap )
2524import Data.Kind ( Constraint, Type )
2625import Data.List.NonEmpty ( NonEmpty )
2726import GHC.Generics ( Generic, Rep, from, to )
@@ -46,19 +45,11 @@ import Rel8.Schema.Null ( NotNull, Sql )
4645import Rel8.Schema.Result ( Col( Result ), Result )
4746import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
4847import 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 )
5448import Rel8.Type ( DBType )
5549
5650-- semigroupoids
5751import Data.Functor.Apply ( WrappedApplicative(..) )
5852
59−-- these
60−import Data.These ( These )
61−
6253
6354type ToExprs :: Type -> Type -> Constraint
6455class Table Expr exprs => ToExprs exprs a where
@@ -126,44 +117,6 @@ instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty
126117 toResult = HType . Result
127118
128119
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−
167120instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ (exprs1, exprs2)) =>
168121 ToExprs x (a, b)
169122
@@ -241,11 +194,6 @@ type FromExprs :: Type -> Type
241194type family FromExprs a
242195type instance FromExprs (Expr a) = a
243196type 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)
249197type instance FromExprs (a, b) = (FromExprs a, FromExprs b)
250198type instance FromExprs (a, b, c) = (FromExprs a, FromExprs b, FromExprs c)
251199type instance FromExprs (a, b, c, d) =
src/Rel8/Table/These.hs+20
@@ -13,6 +13,8 @@
1313{-# language TypeFamilies #-}
1414{-# language UndecidableInstances #-}
1515
16+{-# options_ghc -fno-warn-orphans #-}
17+
1618module Rel8.Table.These
1719 ( TheseTable(..)
1820 , theseTable, thisTable, thatTable, thoseTable
@@ -64,6 +66,7 @@ import Rel8.Table.Maybe
6466 )
6567import Rel8.Table.Ord ( OrdTable, ordTable )
6668import Rel8.Table.Recontextualize ( Recontextualize )
69+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
6770import Rel8.Table.Tag ( Tag(..) )
6871import Rel8.Table.Undefined ( undefined )
6972import Rel8.Type.Tag ( MaybeTag )
@@ -72,6 +75,9 @@ import Rel8.Type.Tag ( MaybeTag )
7275import Data.Functor.Apply ( Apply, (<.>), liftF2 )
7376import Data.Functor.Bind ( Bind, (>>-) )
7477
78+-- these
79+import Data.These ( These )
80+
7581
7682type TheseTable :: Type -> Type -> Type
7783data TheseTable a b = TheseTable
@@ -153,6 +159,20 @@ instance (OrdTable a, OrdTable b) => OrdTable (TheseTable a b) where
153159 ordTable = toColumns2 id id (thoseTable (ordTable @a) (ordTable @b))
154160
155161
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+
156176toHereTag :: Tag "isJust" a -> Tag "hasHere" a
157177toHereTag Tag {..} = Tag {..}
158178