alignBy doesn't actually need any Table constraints

We can use the same technique we use in `optional` to get rid of them.

src/Rel8/Query/Maybe.hs

@@ -13,17 +13,15 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 import qualified Opaleye.Internal.PrimQuery as Opaleye
 import qualified Opaleye.Internal.QueryArr as Opaleye
 import qualified Opaleye.Internal.Tag as Opaleye
-import qualified Opaleye.Internal.Unpackspec as Opaleye
 
 -- rel8
 import Rel8.Expr.Bool ( true )
 import Rel8.Expr.Eq ( (==.) )
-import Rel8.Expr.Opaleye ( toPrimExpr )
+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
 import Rel8.Query ( Query )
 import Rel8.Query.Filter ( where_ )
 import Rel8.Query.Opaleye ( mapOpaleye )
 import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
-import Rel8.Table.Opaleye ( unpackspec )
 import Rel8.Table.Tag ( Tag(..), fromExpr )
 
 
@@ -33,17 +31,18 @@ import Rel8.Table.Tag ( Tag(..), fromExpr )
 -- To speak in more concrete terms, 'optional' is most useful to write @LEFT
 -- JOIN@s.
 optional :: Query a -> Query (MaybeTable a)
-optional = mapOpaleye $ Opaleye.QueryArr . go
-  where
-    go query (i, left, tag) =
-      (MaybeTable (fromExpr t') a, join, Opaleye.next tag')
-      where
-        (MaybeTable Tag {expr = t} a, right, tag') =
-          Opaleye.runSimpleQueryArr (pure <$> query) (i, tag)
-        (t', bindings) = Opaleye.run $
-          Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t
-        join = Opaleye.Join Opaleye.LeftJoin condition [] bindings left right
-        condition = toPrimExpr true
+optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of
+  (_, left, tag) -> (ma', join, tag'')
+    where
+      (ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)
+      MaybeTable Tag {expr = just} a = ma
+      (just', bindings) = Opaleye.run $ do
+        traversePrimExpr (Opaleye.extractAttr "isJust" tag') just
+      tag'' = Opaleye.next tag'
+      join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right
+        where
+          on = toPrimExpr true
+      ma' = MaybeTable (fromExpr just') a
 
 
 -- | Filter out 'MaybeTable's, returning only the tables that are not-null.

src/Rel8/Query/These.hs

@@ -15,26 +15,26 @@ where
 import Prelude
 
 -- opaleye
-import qualified Opaleye.Internal.Join as Opaleye
+import qualified Opaleye.Internal.PackMap as Opaleye
 import qualified Opaleye.Internal.PrimQuery as Opaleye
+import qualified Opaleye.Internal.QueryArr as Opaleye
+import qualified Opaleye.Internal.Tag as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( boolExpr, not_ )
 import Rel8.Expr.Eq ( (==.) )
-import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
+import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
 import Rel8.Expr.Serialize ( litExpr )
 import Rel8.Query ( Query )
 import Rel8.Query.Filter ( where_ )
 import Rel8.Query.Maybe ( optional )
 import Rel8.Query.Opaleye ( zipOpaleyeWith )
-import Rel8.Table ( Table )
 import Rel8.Table.Either ( EitherTable( EitherTable ) )
 import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
-import Rel8.Table.Opaleye ( unpackspec )
-import Rel8.Table.Tag ( Tag(..) )
+import Rel8.Table.Tag ( Tag(..), fromExpr )
 import Rel8.Table.These
-  ( TheseTable( TheseTable )
+  ( TheseTable( TheseTable, here, there )
   , hasHereTable, hasThereTable
   , isThisTable, isThatTable, isThoseTable
   )
@@ -42,17 +42,28 @@ import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
 
 
 -- | Corresponds to a @FULL OUTER JOIN@ between two queries.
-alignBy :: (Table Expr a, Table Expr b)
+alignBy :: ()
   => (a -> b -> Expr Bool)
   -> Query a -> Query b -> Query (TheseTable a b)
-alignBy condition as bs =
-  uncurry TheseTable <$> zipOpaleyeWith fullOuterJoin as bs
-  where
-    fullOuterJoin a b =
-      Opaleye.joinExplicit unpackspec unpackspec pure pure full a b on
-      where
-        full = Opaleye.FullJoin
-        on = toColumn . toPrimExpr . uncurry condition
+alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
+  (_, input, tag) -> (tab, join', tag''')
+    where
+      (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
+      (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
+      MaybeTable Tag {expr = hasHere} a = ma
+      MaybeTable Tag {expr = hasThere} b = mb
+      (hasHere', lbindings) = Opaleye.run $ do
+        traversePrimExpr (Opaleye.extractAttr "hasHere" tag'') hasHere
+      (hasThere', rbindings) = Opaleye.run $ do
+        traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere
+      tag''' = Opaleye.next tag''
+      join = Opaleye.Join Opaleye.FullJoin on lbindings rbindings left' right'
+        where
+          on = toPrimExpr $ condition a b
+      ma' = MaybeTable (fromExpr hasHere') a
+      mb' = MaybeTable (fromExpr hasThere') b
+      tab = TheseTable {here = ma', there = mb'}
+      join' = Opaleye.times input join
 
 
 -- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.