diff --git a/src/Rel8/Query/Maybe.hs b/src/Rel8/Query/Maybe.hs index 2454998..15fe5dd 100644 --- a/src/Rel8/Query/Maybe.hs +++ b/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. diff --git a/src/Rel8/Query/These.hs b/src/Rel8/Query/These.hs index 8fa7a70..62b1178 100644 --- a/src/Rel8/Query/These.hs +++ b/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.