relational-query 0.5.0.3 → 0.5.1.0

raw patch · 5 files changed

+817/−2 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• relational-query.cabal +21/−1
• src/Database/Relational/Query/Arrow.hs +427/−0
• src/Database/Relational/Query/Monad/Aggregate.hs +1/−1
• test/sqlsEqArrow.hs +364/−0

@@ -1,3 +1,7 @@+## 0.5.1.0++- Add the arrow combinator module and its unit-test cases.+ ## 0.5.0.3  - Update unit-test cases.

@@ -1,5 +1,5 @@ name:                relational-query-version:             0.5.0.3+version:             0.5.1.0 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can@@ -22,6 +22,8 @@  library   exposed-modules:+                       Database.Relational.Query.Arrow+                        Database.Relational.Query                        Database.Relational.Query.Table                        Database.Relational.Query.SQL@@ -91,6 +93,24 @@    type:                exitcode-stdio-1.0   main-is:             sqlsEq.hs+  other-modules:+                       Lex+                       Model++  hs-source-dirs:      test+  ghc-options:         -Wall++  default-language:     Haskell2010++test-suite sqlsArrow+  build-depends:         base <5+                       , quickcheck-simple+                       , relational-query+                       , containers+                       , transformers++  type:                exitcode-stdio-1.0+  main-is:             sqlsEqArrow.hs   other-modules:                        Lex                        Model

@@ -0,0 +1,427 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module      : Database.Relational.Query.Arrow+-- Copyright   : 2015 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines arrow version combinators which+-- improves type-safty on building queries.+-- Referencing the local projections may cause to break+-- the result query.+-- It is possible to controls injection of previous local projections+-- by restricting domain type of arrow. This idea is imported from Opaleye.+-- (https://github.com/tomjaguarpaw/haskell-opaleye,+--  https://github.com/khibino/haskell-relational-record/issues/19).+--+-- Importing this module instead of "Database.Relational.Query" enables+-- to build query using arrow combinators.+module Database.Relational.Query.Arrow (+  module Database.Relational.Query,++  all', distinct,++  query, queryMaybe, query', queryMaybe',+  queryList, queryList', queryExists, queryExists', queryListU, queryListU',+  queryScalar, queryScalar', queryScalarU, queryScalarU',++  uniqueQuery', uniqueQueryMaybe',++  on, wheres, having, groupBy, placeholder,++  relation, relation', aggregateRelation, aggregateRelation',++  uniqueRelation',++  groupBy', key, key', set, bkey, rollup, cube, groupingSets,++  orderBy, asc, desc,++  partitionBy, over,++  assign,++  derivedUpdate', derivedUpdate,+  derivedDelete', derivedDelete,++  QueryA,++  QuerySimple, QueryAggregate, QueryUnique,++  AggregatingSet, AggregatingSetList, AggregatingPowerSet,++  Orderings, Window, Assignings,++  UpdateTargetContext, RestrictionContext,+  ) where++import Control.Category (Category)+import Control.Arrow (Arrow, Kleisli (..))++import Database.Record+import Database.Relational.Query hiding+  (all', distinct,+   query, queryMaybe, query', queryMaybe',+   queryList, queryList', queryScalar, queryScalar',+   uniqueQuery', uniqueQueryMaybe',+   on, wheres, having, groupBy, placeholder,+   relation, relation', aggregateRelation, aggregateRelation', uniqueRelation',+   groupBy', key, key', set, bkey, rollup, cube, groupingSets,+   orderBy, asc, desc, partitionBy, over,+   derivedUpdate', derivedUpdate, derivedDelete', derivedDelete,+   QuerySimple, QueryAggregate, QueryUnique, Window,+   UpdateTargetContext, RestrictionContext)+import qualified Database.Relational.Query as Monadic+import Database.Relational.Query.Monad.Class (MonadQualifyUnique)+import Database.Relational.Query.Projection (ListProjection)+import Database.Relational.Query.Monad.Trans.Aggregating (AggregateKey)+import qualified Database.Relational.Query.Monad.Trans.Aggregating as Monadic+import qualified Database.Relational.Query.Monad.Trans.Ordering as Monadic+import qualified Database.Relational.Query.Monad.Trans.Assigning as Monadic+++-- | Arrow to build queries.+newtype QueryA m a b = QueryA (Kleisli m a b) deriving (Category, Arrow)++queryA :: (a -> m b) -> QueryA m a b+queryA = QueryA . Kleisli++runQueryA :: QueryA m a b -> a -> m b+runQueryA (QueryA k) = runKleisli k++runAofM :: (m b -> c) -> QueryA m () b -> c+runAofM = (. (`runQueryA` ()))++-- | Arrow type corresponding to 'Monadic.QuerySimple'+type QuerySimple    = QueryA Monadic.QuerySimple++-- | Arrow type corresponding to 'Monadic.QueryAggregate'+type QueryAggregate = QueryA Monadic.QueryAggregate++-- | Arrow type corresponding to 'Monadic.QueryUnique'+type QueryUnique = QueryA Monadic.QueryUnique++-- | Arrow type corresponding to 'Monadic.AggregatingSet'+type AggregatingSet = QueryA Monadic.AggregatingSet++-- | Arrow type corresponding to 'Monadic.AggregatingSetList'+type AggregatingSetList = QueryA Monadic.AggregatingSetList++-- | Arrow type corresponding to 'Monadic.AggregatingPowerSet'+type AggregatingPowerSet = QueryA Monadic.AggregatingPowerSet++-- | Arrow type corresponding to 'Monadic.Orderings'+type Orderings c m = QueryA (Monadic.Orderings c m)++-- | Arrow type corresponding to 'Monadic.Window'+type Window c = QueryA (Monadic.Window c)++-- | Arrow type corresponding to 'Monadic.Assignings'+type Assignings r m = QueryA (Monadic.Assignings r m)++-- | Arrow type corresponding to 'Monadic.UpdateTargetContext'+type UpdateTargetContext p r = Assignings r Restrict (Projection Flat r) (PlaceHolders p)++-- | Arrow type corresponding to 'Monadic.RestrictionContext'+type RestrictionContext p r = QueryA Monadic.Restrict (Projection Flat r) (PlaceHolders p)+++-- | Same as 'Monadic.all''. Arrow version.+all' :: MonadQuery m => QueryA m () ()+all' = queryA $ \() -> Monadic.all'++-- | Same as 'Monadic.distinct'. Arrow version.+distinct :: MonadQuery m => QueryA m () ()+distinct = queryA $ \() -> Monadic.distinct++-- | Same as 'Monadic.query'. Arrow version.+--   The result arrow is not injected by local projections.+query :: (MonadQualify ConfigureQuery m, MonadQuery m)+      => Relation () r -> QueryA m () (Projection Flat r)+query r = queryA $ \() -> Monadic.query r++-- | Same as 'Monadic.queryMaybe'. Arrow version.+--   The result arrow is not injected by any local projections.+queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m)+           => Relation () r -> QueryA m () (Projection Flat (Maybe r))+queryMaybe r = queryA $ \() -> Monadic.queryMaybe r++-- | Same as 'Monadic.query''. Arrow version.+--   The result arrow is not injected by any local projections.+query' :: (MonadQualify ConfigureQuery m, MonadQuery m)+       => Relation p r -> QueryA m () (PlaceHolders p, Projection Flat r)+query' r = queryA $ \() -> Monadic.query' r++-- | Same as 'Monadic.queryMaybe''. Arrow version.+--   The result arrow is not injected by any local projections.+queryMaybe' :: (MonadQualify ConfigureQuery m, MonadQuery m)+            => Relation p r -> QueryA m () (PlaceHolders p, Projection Flat (Maybe r))+queryMaybe' r = queryA $ \() -> Monadic.queryMaybe' r++unsafeQueryList :: MonadQualify ConfigureQuery m+            => (a -> Relation () r)+            -> QueryA m a (ListProjection (Projection c) r)+unsafeQueryList rf = queryA $ Monadic.queryList . rf++unsafeQueryList' :: MonadQualify ConfigureQuery m+             => (a -> Relation p r)+             -> QueryA m a (PlaceHolders p, ListProjection (Projection c) r)+unsafeQueryList' rf = queryA $ Monadic.queryList' . rf++-- | Same as 'Monadic.queryList'. Arrow version.+--   The result arrow is designed to be injected by local projections.+queryList :: MonadQualify ConfigureQuery m+          => (Projection c a -> Relation () r)+          -> QueryA m (Projection c a) (ListProjection (Projection c) r)+queryList = unsafeQueryList++-- | Same as 'Monadic.queryList''. Arrow version.+--   The result arrow is designed to be injected by local projections.+queryList' :: MonadQualify ConfigureQuery m+           => (Projection c a -> Relation p r)+           -> QueryA m (Projection c a) (PlaceHolders p, ListProjection (Projection c) r)+queryList' = unsafeQueryList'++-- | Same as 'Monadic.queryList' to pass this result to 'exists' operator. Arrow version.+--   The result arrow is designed to be injected by local projections.+queryExists :: MonadQualify ConfigureQuery m+          => (Projection c a -> Relation () r)+          -> QueryA m (Projection c a) (ListProjection (Projection Exists) r)+queryExists = unsafeQueryList++-- | Same as 'Monadic.queryList'' to pass this result to 'exists' operator. Arrow version.+--   The result arrow is designed to be injected by local projections.+queryExists' :: MonadQualify ConfigureQuery m+           => (Projection c a -> Relation p r)+           -> QueryA m (Projection c a) (PlaceHolders p, ListProjection (Projection Exists) r)+queryExists' = unsafeQueryList'++-- | Same as 'Monadic.queryList'. Arrow version.+--   Useful for no reference cases to local projections.+queryListU :: MonadQualify ConfigureQuery m+           => Relation () r+           -> QueryA m () (ListProjection (Projection c) r)+queryListU r = unsafeQueryList $ \() -> r++-- | Same as 'Monadic.queryList''. Arrow version.+--   Useful for no reference cases to local projections.+queryListU' :: MonadQualify ConfigureQuery m+           => Relation p r+           -> QueryA m () (PlaceHolders p, ListProjection (Projection c) r)+queryListU' r = unsafeQueryList' $ \() -> r++unsafeQueryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)+                  => (a -> UniqueRelation () c r)+                  -> QueryA m a (Projection c (Maybe r))+unsafeQueryScalar rf = queryA $ Monadic.queryScalar . rf++unsafeQueryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)+                   => (a -> UniqueRelation p c r)+                   -> QueryA m a (PlaceHolders p, Projection c (Maybe r))+unsafeQueryScalar' rf = queryA $ Monadic.queryScalar' . rf++-- | Same as 'Monadic.queryScalar'. Arrow version.+--   The result arrow is designed to be injected by any local projection.+queryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)+            => (Projection c a -> UniqueRelation () c r)+            -> QueryA m (Projection c a) (Projection c (Maybe r))+queryScalar = unsafeQueryScalar++-- | Same as 'Monadic.queryScalar''. Arrow version.+--   The result arrow is designed to be injected by any local projection.+queryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)+             => (Projection c a -> UniqueRelation p c r)+             -> QueryA m (Projection c a) (PlaceHolders p, Projection c (Maybe r))+queryScalar' = unsafeQueryScalar'++-- | Same as 'Monadic.queryScalar'. Arrow version.+--   Useful for no reference cases to local projections.+queryScalarU :: (MonadQualify ConfigureQuery m, ScalarDegree r)+            => UniqueRelation () c r+            -> QueryA m () (Projection c (Maybe r))+queryScalarU r = unsafeQueryScalar $ \() -> r++-- | Same as 'Monadic.queryScalar''. Arrow version.+--   Useful for no reference cases to local projections.+queryScalarU' :: (MonadQualify ConfigureQuery m, ScalarDegree r)+             => UniqueRelation p c r+             -> QueryA m () (PlaceHolders p, Projection c (Maybe r))+queryScalarU' r = unsafeQueryScalar' $ \() -> r++-- | Same as 'Monadic.uniqueQuery''. Arrow version.+--   The result arrow is not injected by local projections.+uniqueQuery' :: MonadQualifyUnique ConfigureQuery m+             => UniqueRelation p c r+             -> QueryA m () (PlaceHolders p, Projection c r)+uniqueQuery' r = queryA $ \() -> Monadic.uniqueQuery' r++-- | Same as 'Monadic.uniqueQueryMaybe''. Arrow version.+--   The result arrow is not injected by local projections.+uniqueQueryMaybe' :: MonadQualifyUnique ConfigureQuery m+                  => UniqueRelation p c r+                  -> QueryA m () (PlaceHolders p, Projection c (Maybe r))+uniqueQueryMaybe' r = queryA $ \() -> Monadic.uniqueQueryMaybe' r++-- | Same as 'Monadic.on'. Arrow version.+--   The result arrow is designed to be injected by local conditional flat-projections.+on :: MonadQuery m+   => QueryA m (Projection Flat (Maybe Bool)) ()+on = queryA Monadic.on++-- | Same as 'Monadic.wheres'. Arrow version.+--   The result arrow is designed to be injected by local conditional flat-projections.+wheres :: MonadRestrict Flat m+       => QueryA m (Projection Flat (Maybe Bool)) ()+wheres = queryA Monadic.wheres++-- | Same as 'Monadic.having'. Arrow version.+--   The result arrow is designed to be injected by local conditional aggregated-projections.+having :: MonadRestrict Aggregated m+       => QueryA m (Projection Aggregated (Maybe Bool)) ()+having = queryA Monadic.having++-- | Same as 'Monadic.groupBy'. Arrow version.+--   The result arrow is designed to be injected by local flat-projections.+groupBy :: MonadAggregate m+        => QueryA m (Projection Flat r) (Projection Aggregated r)+groupBy = queryA Monadic.groupBy++-- | Same as 'Monadic.placeholder'. Arrow version.+--   The result arrow is designed to be injected by locally built arrow using placeholders.+placeholder :: (PersistableWidth t, SqlProjectable p, Monad m)+            => QueryA m (QueryA m (p t) a) (PlaceHolders t, a)+placeholder = queryA $ Monadic.placeholder . runQueryA++-- | Same as 'Monadic.relation'.+--   Finalize query-building arrow instead of query-building monad.+relation :: QuerySimple () (Projection Flat r)+         -> Relation () r+relation = runAofM Monadic.relation++-- | Same as 'Monadic.relation''.+--   Finalize query-building arrow instead of query-building monad.+relation' :: QuerySimple () (PlaceHolders p, Projection Flat r)+          -> Relation p r+relation' = runAofM Monadic.relation'++-- | Same as 'Monadic.aggregateRelation'.+--   Finalize query-building arrow instead of query-building monad.+aggregateRelation :: QueryAggregate () (Projection Aggregated r)+                  -> Relation () r+aggregateRelation = runAofM Monadic.aggregateRelation++-- | Same as 'Monadic.aggregateRelation''.+--   Finalize query-building arrow instead of query-building monad.+aggregateRelation' :: QueryAggregate () (PlaceHolders p, Projection Aggregated r)+                   -> Relation p r+aggregateRelation' = runAofM Monadic.aggregateRelation'++-- | Same as 'Monadic.uniqueRelation''.+--   Finalize query-building arrow instead of query-building monad.+uniqueRelation' :: QueryUnique () (PlaceHolders p, Projection c r)+                -> UniqueRelation p c r+uniqueRelation' = runAofM Monadic.uniqueRelation'++-- | Same as 'Monadic.groupBy''.+--   This arrow is designed to be injected by local 'AggregateKey'.+groupBy' :: MonadAggregate m => QueryA m (AggregateKey a) a+groupBy' = queryA Monadic.groupBy'++-- | Same as 'Monadic.key'.+--   This arrow is designed to be injected by local flat-projections.+key :: AggregatingSet (Projection Flat r) (Projection Aggregated (Maybe r))+key = queryA Monadic.key++-- | Same as 'Monadic.key''.+--   This arrow is designed to be injected by local 'AggregteKey'.+key' :: AggregatingSet (AggregateKey a) a+key' = queryA Monadic.key'++-- | Same as 'Monadic.set'.+--   This arrow is designed to be injected by locally built 'AggregtingSet' arrow.+set :: AggregatingSetList (AggregatingSet () a) a+set = queryA $ runAofM Monadic.set++-- | Same as 'Monadic.bkey'.+--   This arrow is designed to be injected by local flat-projections.+bkey :: AggregatingPowerSet (Projection Flat r) (Projection Aggregated (Maybe r))+bkey = queryA Monadic.bkey++-- | Same as 'Monadic.rollup'.+--   Finalize locally built 'AggregatingPowerSet'.+rollup :: AggregatingPowerSet () a -> AggregateKey a+rollup = runAofM Monadic.rollup++-- | Same as 'Monadic.cube'.+--   Finalize locally built 'AggregatingPowerSet'.+cube :: AggregatingPowerSet () a -> AggregateKey a+cube = runAofM Monadic.cube++-- | Same as 'Monadic.groupingSets'.+--   Finalize locally built 'AggregatingSetList'.+groupingSets :: AggregatingSetList () a -> AggregateKey a+groupingSets = runAofM Monadic.groupingSets++-- | Same as 'Monadic.orderBy'.+--   The result arrow is designed to be injected by local projections.+orderBy :: Monad m+        => Order+        -> Orderings c m (Projection c t) ()+orderBy o = queryA (`Monadic.orderBy` o)++-- | Same as 'Monadic.asc'.+--   The result arrow is designed to be injected by local projections.+asc :: Monad m+    => Orderings c m (Projection c t) ()+asc = queryA Monadic.asc++-- | Same as 'Monadic.desc'.+--   The result arrow is designed to be injected by local projections.+desc :: Monad m+     => Orderings c m (Projection c t) ()+desc = queryA Monadic.desc++-- | Same as 'Monadic.partitionBy'.+--   The result arrow is designed to be injected by local projections.+partitionBy :: Window c (Projection c r) ()+partitionBy = queryA Monadic.partitionBy++-- | Same as 'Monadic.over'.+--   Make window function result projection using built 'Window' arrow.+over :: SqlProjectable (Projection c)+     => Projection OverWindow a -> Window c () () -> Projection c a+over po = runAofM $ Monadic.over po++infix 8 `over`++-- | Make 'Monadic.AssignTarget' into arrow which is designed to be+--   injected by local projection assignees.+assign :: Monad m+       => Monadic.AssignTarget r v+       -> Assignings r m (Projection Flat v) ()+assign t = queryA (`Monadic.assignTo` t)++-- | Same as 'Monadic.derivedUpdate''.+--   Make 'Update' from assigning statement arrow using configuration.+derivedUpdate' :: TableDerivable r => Config -> UpdateTargetContext p r -> Update p+derivedUpdate' config = Monadic.derivedUpdate' config . runQueryA++-- | Same as 'Monadic.derivedUpdate'.+--   Make 'Update' from assigning statement arrow.+derivedUpdate :: TableDerivable r => UpdateTargetContext p r -> Update p+derivedUpdate = Monadic.derivedUpdate . runQueryA++-- | Same as 'Monadic.derivedDelete''.+--   Make 'Update' from restrict statement arrow using configuration.+derivedDelete' :: TableDerivable r => Config -> RestrictionContext p r -> Delete p+derivedDelete' config = Monadic.derivedDelete' config . runQueryA++-- | Same as 'Monadic.derivedDelete'.+--   Make 'Update' from restrict statement arrow.+derivedDelete :: TableDerivable r => RestrictionContext p r -> Delete p+derivedDelete = Monadic.derivedDelete . runQueryA

@@ -99,7 +99,7 @@ extractWindow :: Window c a -> ((a, OrderingTerms), [AggregateColumnRef]) extractWindow =  runIdentity . extractAggregateTerms . extractOrderingTerms --- | Operator to make window function projection.+-- | Operator to make window function result projection using built 'Window' monad. over :: SqlProjectable (Projection c)      => Projection OverWindow a      -> Window c ()

@@ -0,0 +1,364 @@+{-# LANGUAGE Arrows #-}++import Test.QuickCheck.Simple (Test, defaultMain)++import Lex (eqProp)+import Model++import Data.Int (Int32, Int64)+import Control.Arrow (returnA, arr, (<<<), (***))+import Database.Relational.Query.Arrow++numBin :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> Relation () r+numBin op = relation $ proc () -> do+  returnA -< value 5 `op` value 3++strConcat :: Relation () String+strConcat = relation $ proc () -> do+  returnA -< value "Hello, " .||. value "World!"++strLike :: Relation () (Maybe Bool)+strLike = relation $ proc () -> do+  returnA -< value "Hoge" `like` "H%"++_p_numBin :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> IO ()+_p_numBin = print . numBin++bin :: [Test]+bin =+  [ eqProp "plus"  (numBin (.+.)) "SELECT ALL (5 + 3) AS f0"+  , eqProp "minus" (numBin (.-.)) "SELECT ALL (5 - 3) AS f0"+  , eqProp "mult"  (numBin (.*.)) "SELECT ALL (5 * 3) AS f0"+  , eqProp "div"   (numBin (./.)) "SELECT ALL (5 / 3) AS f0"+  , eqProp "string concat" strConcat "SELECT ALL ('Hello, ' || 'World!') AS f0"+  , eqProp "like" strLike "SELECT ALL ('Hoge' LIKE 'H%') AS f0"+  ]++tables :: [Test]+tables =+  [ eqProp "setA" setA "SELECT int_a0, str_a1, str_a2 FROM TEST.set_a"+  , eqProp "setB" setB "SELECT int_b0, may_str_b1, str_b2 FROM TEST.set_b"+  , eqProp "setC" setC "SELECT int_c0, str_c1, int_c2, may_str_c3 FROM TEST.set_c"+  ]++_p_tables :: IO ()+_p_tables =  mapM_ print [show setA, show setB, show setC]++cross :: Relation () (SetA, SetB)+cross =  setA `inner` setB `on'` []++innerX :: Relation () (SetA, SetB)+innerX =  setA `inner` setB `on'` [ \a b -> a ! intA0' .=. b ! intB0' ]++leftX :: Relation () (SetA, Maybe SetB)+leftX =  setA `left` setB `on'` [ \a b -> just (a ! strA1') .=. b ?!? mayStrB1' ]++rightX :: Relation () (Maybe SetA, SetB)+rightX =  setA `right` setB  `on'` [ \a b -> a ?! intA0' .=. just (b ! intB0') ]++fullX :: Relation () (Maybe SetA, Maybe SetB)+fullX =  setA `full` setB `on'` [ \a b -> a ?! intA0' .=. b ?! intB0' ]++directJoins :: [Test]+directJoins =+  [ eqProp "cross" cross+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 INNER JOIN TEST.set_b T1 ON (0=0)"+  , eqProp "inner" innerX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 INNER JOIN TEST.set_b T1 ON (T0.int_a0 = T1.int_b0)"+  , eqProp "left" leftX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 LEFT JOIN TEST.set_b T1 ON (T0.str_a1 = T1.may_str_b1)"+  , eqProp "right" rightX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 RIGHT JOIN TEST.set_b T1 ON (T0.int_a0 = T1.int_b0)"+  , eqProp "full" fullX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 FULL JOIN TEST.set_b T1 ON (T0.int_a0 = T1.int_b0)"+  ]++_p_directJoins :: IO ()+_p_directJoins =  mapM_ print [show cross, show innerX, show leftX, show rightX, show fullX]+++j3left :: Relation () Abc+j3left =  relation $ proc () -> do+  a <- query setA -< ()+  b <- queryMaybe setB -< ()+  on -< just (a ! strA2') .=. b ?! strB2'+  c <- queryMaybe setC -< ()+  on -< b ?! intB0' .=. c ?! intC0'++  returnA -< Abc |$| a |*| b |*| c++j3right :: Relation () Abc+j3right =  relation $ proc () -> do+  a  <- query setA -< ()+  bc <- query $ setB `full` setC `on'` [ \b c -> b ?! intB0' .=. c ?! intC0' ] -< ()+  let b = bc ! fst'+      c = bc ! snd'+  on -< just (a ! strA2') .=. b ?! strB2'++  returnA -< Abc |$| a |*| b |*| c++join3s :: [Test]+join3s =+  [ eqProp "join-3 left" j3left+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5, \+    \           T2.int_c0 AS f6, T2.str_c1 AS f7, T2.int_c2 AS f8, T2.may_str_c3 AS f9 \+    \  FROM (TEST.set_a T0 LEFT JOIN TEST.set_b T1 ON (T0.str_a2 = T1.str_b2)) \+    \        LEFT JOIN TEST.set_c T2 ON (T1.int_b0 = T2.int_c0)"++  , eqProp "join-3 right" j3right+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T3.f0 AS f3, T3.f1 AS f4, T3.f2 AS f5, T3.f3 AS f6, T3.f4 AS f7, T3.f5 AS f8, T3.f6 AS f9 \+    \  FROM TEST.set_a T0 \+    \       INNER JOIN (SELECT ALL T1.int_b0 AS f0, T1.may_str_b1 AS f1, T1.str_b2 AS f2, \+    \                              T2.int_c0 AS f3, T2.str_c1 AS f4, T2.int_c2 AS f5, T2.may_str_c3 AS f6 \+    \                     FROM TEST.set_b T1 FULL JOIN TEST.set_c T2 ON (T1.int_b0 = T2.int_c0)) T3 \+    \               ON (T0.str_a2 = T3.f2)"+  ]++_p_j3s :: IO ()+_p_j3s =  mapM_ print [show j3left, show j3right]++justX :: Relation () (SetA, Maybe SetB)+justX =  relation $ proc () -> do+  a <- query setA -< ()+  b <- queryMaybe setB -< ()++  wheres -< isJust b `or'` a ! intA0' .=. value 1++  returnA -< a >< b++maybeX :: Relation () (Int32, SetB)+maybeX =  relation $ proc () -> do+  a <- queryMaybe setA -< ()+  b <- query setB -< ()++  wheres -< a ?! strA2' .=. b ! mayStrB1'++  returnA -< fromMaybe (value 1) (a ?! intA0') >< b++maybes :: [Test]+maybes =+  [ eqProp "isJust" justX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 LEFT JOIN TEST.set_b T1 ON (0=0) \+    \ WHERE ((NOT (T1.int_b0 IS NULL)) OR (T0.int_a0 = 1))"+  , eqProp "fromMaybe" maybeX+    "SELECT ALL CASE WHEN (T0.int_a0 IS NULL) THEN 1 ELSE T0.int_a0 END AS f0, \+    \           T1.int_b0 AS f1, T1.may_str_b1 AS f2, T1.str_b2 AS f3 \+    \  FROM TEST.set_a T0 RIGHT JOIN TEST.set_b T1 ON (0=0) WHERE (T0.str_a2 = T1.may_str_b1)"+  ]++_p_maybes :: IO ()+_p_maybes =  mapM_ print [show justX, show maybeX]++groupX :: Relation () (String, Int64)+groupX =  aggregateRelation $ proc () -> do+  c <- query setC -< ()++  gc1 <- groupBy -< c ! strC1'+  returnA -< gc1 >< count (c ! intC0')++cubeX :: Relation () ((Maybe String, Maybe (Int64, Maybe String)), Maybe Int32)+cubeX =  aggregateRelation $ proc () -> do+  c <- query setC -< ()++  gCube <- groupBy' -< cube $ proc () -> do+    arr (uncurry (><)) <<< bkey *** bkey+      -< (c ! strC1', c ! intC2' >< c ! mayStrC3')+  returnA -< gCube >< sum' (c ! intC0')++groupingSetsX :: Relation () (((Maybe String, Maybe (Maybe String)), Maybe Int64), Maybe Int64)+groupingSetsX = aggregateRelation $ proc () -> do+  c <- query setC -< ()++  gs <- groupBy' -< groupingSets $ proc () -> do+    s1 <- set -< proc () -> do+      gRollup <- key' -< rollup $ proc () -> do+        arr (uncurry (><)) <<< bkey *** bkey+          -< (c ! strC1', c ! mayStrC3')+      gc2 <- key -< c ! intC2'+      returnA -< gRollup >< gc2+    s2 <- set -< proc () -> do key -< c ! intC2'+    returnA -< s1 >< s2++  returnA -< gs++groups :: [Test]+groups =+  [ eqProp "group" groupX+    "SELECT ALL T0.str_c1 AS f0, COUNT(T0.int_c0) AS f1 \+    \  FROM TEST.set_c T0 GROUP BY T0.str_c1"+  , eqProp "cube" cubeX+    "SELECT ALL T0.str_c1 AS f0, T0.int_c2 AS f1, T0.may_str_c3 AS f2, SUM(T0.int_c0) AS f3 \+    \  FROM TEST.set_c T0 GROUP BY CUBE ((T0.str_c1), (T0.int_c2, T0.may_str_c3))"+  , eqProp "groupingSets" groupingSetsX+    "SELECT ALL T0.str_c1 AS f0, T0.may_str_c3 AS f1, T0.int_c2 AS f2, T0.int_c2 AS f3 \+    \  FROM TEST.set_c T0 GROUP BY \+    \  GROUPING SETS ((ROLLUP ((T0.str_c1), (T0.may_str_c3)), T0.int_c2), (T0.int_c2))"+  ]++_p_groups :: IO ()+_p_groups =  mapM_ print [show groupX, show cubeX, show groupingSetsX]++ordFlatX :: Relation () (SetA, Maybe SetB)+ordFlatX =  relation $ proc () -> do+  a <- query setA -< ()+  b <- queryMaybe setB -< ()+  on -< just (a ! strA2') .=. b ?! strB2'++  orderBy Asc  -< a ! strA1'+  orderBy Desc -< b ?! mayStrB1'++  returnA -< (,) |$| a |*| b++ordAggX :: Relation () (String, Int64)+ordAggX =  aggregateRelation $ proc () -> do+  c <- query setC -< ()++  gc1 <- groupBy -< c ! strC1'++  orderBy Asc -< sum' $ c ! intC0'++  returnA -< gc1 >< count (c ! intC0')++_p_orders :: IO ()+_p_orders = mapM_ print [show ordFlatX, show ordAggX]++orders :: [Test]+orders =+  [ eqProp "order-by - flat" ordFlatX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \           T1.int_b0 AS f3, T1.may_str_b1 AS f4, T1.str_b2 AS f5 \+    \  FROM TEST.set_a T0 LEFT JOIN TEST.set_b T1 ON (T0.str_a2 = T1.str_b2) \+    \  ORDER BY T0.str_a1 ASC, T1.may_str_b1 DESC"+  , eqProp "order-by - aggregated" ordAggX+    "SELECT ALL T0.str_c1 AS f0, COUNT(T0.int_c0) AS f1 \+    \  FROM TEST.set_c T0 GROUP BY T0.str_c1 ORDER BY SUM(T0.int_c0) ASC"+  ]++partitionX :: Relation () (String, Int64)+partitionX =  relation $ proc () -> do+  c <- query setC -< ()++  returnA -< (c ! strC1') >< rank `over` proc () -> do+    partitionBy -< c ! strC1'+    orderBy Asc -< c ! intC2'++partitionY :: Relation () (String, (Int64, Maybe Int32))+partitionY =  relation $ proc () -> do+  c <- query setC -< ()++  returnA -< (c ! strC1') >< (rank >< sum' (c ! intC0')) `over` proc () -> do+    partitionBy -< c ! strC1'+    orderBy Asc -< c ! intC2'++partitions :: [Test]+partitions =+  [ eqProp "partition 0"  partitionX+    "SELECT ALL T0.str_c1 AS f0, \+    \           RANK() OVER (PARTITION BY T0.str_c1 ORDER BY T0.int_c2 ASC) AS f1 \+    \  FROM TEST.set_c T0"+  , eqProp "partition 1"  partitionY+    "SELECT ALL T0.str_c1 AS f0, \+    \           RANK()         OVER (PARTITION BY T0.str_c1 ORDER BY T0.int_c2 ASC) AS f1, \+    \           SUM(T0.int_c0) OVER (PARTITION BY T0.str_c1 ORDER BY T0.int_c2 ASC) AS f2 \+    \      FROM TEST.set_c T0"+  ]++_p_partitions :: IO ()+_p_partitions =  mapM_ print [show partitionX, show partitionY]++setAFromB :: Pi SetB SetA+setAFromB =  SetA |$| intB0' |*| strB2' |*| strB2'++aFromB :: Relation () SetA+aFromB =  relation $ proc () -> do+  x <- query setB -< ()+  returnA -< x ! setAFromB++unionX :: Relation () SetA+unionX =  setA `union` aFromB++unionAllX :: Relation () SetA+unionAllX =  setA `unionAll` aFromB++exceptX :: Relation () SetA+exceptX =  setA `except` aFromB++intersectX :: Relation () SetA+intersectX =  setA `intersect` aFromB++exps :: [Test]+exps =+  [ eqProp "union" unionX+    "SELECT int_a0 AS f0, str_a1 AS f1, str_a2 AS f2 FROM TEST.set_a UNION \+    \SELECT ALL T0.int_b0 AS f0, T0.str_b2 AS f1, T0.str_b2 AS f2 FROM TEST.set_b T0"+  , eqProp "unionAll" unionAllX+    "SELECT int_a0 AS f0, str_a1 AS f1, str_a2 AS f2 FROM TEST.set_a UNION ALL \+    \SELECT ALL T0.int_b0 AS f0, T0.str_b2 AS f1, T0.str_b2 AS f2 FROM TEST.set_b T0"+  , eqProp "except" exceptX+    "SELECT int_a0 AS f0, str_a1 AS f1, str_a2 AS f2 FROM TEST.set_a EXCEPT \+    \SELECT ALL T0.int_b0 AS f0, T0.str_b2 AS f1, T0.str_b2 AS f2 FROM TEST.set_b T0"+  , eqProp "intersect" intersectX+    "SELECT int_a0 AS f0, str_a1 AS f1, str_a2 AS f2 FROM TEST.set_a INTERSECT \+    \SELECT ALL T0.int_b0 AS f0, T0.str_b2 AS f1, T0.str_b2 AS f2 FROM TEST.set_b T0"+  ]++insertX :: Insert SetA+insertX =  derivedInsert id'++insertI :: Insert SetI+insertI =  derivedInsert id'++insertQueryX :: InsertQuery ()+insertQueryX =  derivedInsertQuery setAFromB setA++updateKeyX :: KeyUpdate Int32 SetA+updateKeyX =  primaryUpdate tableOfSetA++updateX :: Update ()+updateX =  derivedUpdate $ proc proj -> do+  assign strA2' -< value "X"+  wheres -< proj ! strA1' .=. value "A"+  returnA -< unitPlaceHolder++deleteX :: Delete ()+deleteX =  derivedDelete $ proc proj -> do+  wheres -< proj ! strA1' .=. value "A"+  returnA -< unitPlaceHolder++effs :: [Test]+effs =+  [ eqProp "insert" insertX+    "INSERT INTO TEST.set_a (int_a0, str_a1, str_a2) VALUES (?, ?, ?)"+  , eqProp "insert1" insertI+    "INSERT INTO TEST.set_i (int_i0) VALUES (?)"+  , eqProp "insertQuery" insertQueryX+    "INSERT INTO TEST.set_b (int_b0, str_b2, str_b2) SELECT int_a0, str_a1, str_a2 FROM TEST.set_a"+  , eqProp "updateKey" updateKeyX+    "UPDATE TEST.set_a SET str_a1 = ?, str_a2 = ? WHERE int_a0 = ?"+  , eqProp "update" updateX+    "UPDATE TEST.set_a SET str_a2 = 'X' WHERE (str_a1 = 'A')"+  , eqProp "delete" deleteX+    "DELETE FROM TEST.set_a WHERE (str_a1 = 'A')"+  ]++tests :: [Test]+tests =+  concat [ bin, tables, directJoins, join3s, maybes+         , groups, orders, partitions, exps, effs]++main :: IO ()+main = defaultMain tests