packages feed

relational-query 0.6.3.0 → 0.6.4.0

raw patch · 7 files changed

+274/−53 lines, 7 filesdep ~names-th

Dependency ranges changed: names-th

Files

ChangeLog.md view
@@ -1,3 +1,10 @@+<!-- -*- Markdown -*- -->++## 0.6.4.0++- Fix around correlated sub-queries.+- Update unit-test cases.+ ## 0.6.3.0  - Add Int8 type as SQL constant int value. (e.g. MySQL)
relational-query.cabal view
@@ -1,5 +1,5 @@ name:                relational-query-version:             0.6.3.0+version:             0.6.4.0 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can
src/Database/Relational/Query/Monad/Restrict.hs view
@@ -23,9 +23,8 @@ import Database.Relational.Query.Component (Config, QueryRestriction) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection)-import Database.Relational.Query.Monad.Class (MonadQualify(..)) import Database.Relational.Query.Monad.Trans.Restricting-  (Restrictings, restrictings, extractRestrict)+  (Restrictings, extractRestrict) import Database.Relational.Query.Monad.BaseType (ConfigureQuery, configureQuery)  @@ -36,10 +35,6 @@ --   Projection record type 'r' must be --   the same as 'Restrictings' type parameter 'r'. type RestrictedStatement r a = Projection Flat r -> Restrict a---- | Instance to lift from qualified table forms into 'Restrict'.-instance MonadQualify ConfigureQuery Restrict where-  liftQualify = restrictings  -- -- | 'return' of 'Restrict' -- restricted :: a -> Restrict a
src/Database/Relational/Query/Monad/Trans/Assigning.hs view
@@ -38,7 +38,7 @@ import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection -import Database.Relational.Query.Monad.Class (MonadRestrict(..))+import Database.Relational.Query.Monad.Class (MonadQualify (..), MonadRestrict(..))   -- | Type to accumulate assigning context.@@ -51,9 +51,13 @@ assignings :: Monad m => m a -> Assignings r m a assignings =  lift --- | 'MonadRestrict' with ordering.+-- | 'MonadRestrict' with assigning. instance MonadRestrict c m => MonadRestrict c (Assignings r m) where   restrict = assignings . restrict++-- | 'MonadQualify' with assigning.+instance MonadQualify q m => MonadQualify q (Assignings r m) where+  liftQualify = assignings . liftQualify  -- | Target of assignment. type AssignTarget r v = Pi r v
src/Database/Relational/Query/Projectable.hs view
@@ -34,23 +34,24 @@   ProjectableShowSql (unsafeShowSql'), unsafeShowSql,    -- * Operators-  SqlBinOp,-  unsafeBinOp,--  unsafeUniOp,-   (.=.), (.<.), (.<=.), (.>.), (.>=.), (.<>.), -  casesOrElse, casesOrElse',-  caseSearch, caseSearchMaybe, case', caseMaybe,-  in', and', or',+  and', or', in', +  (.||.), (?||?), like, likeMaybe, like', likeMaybe',+  (.+.), (.-.), (.*.), (./.),+  (?+?), (?-?), (?*?), (?/?),+   isNothing, isJust, fromMaybe,   not', exists, -  (.||.), (?||?), like, likeMaybe, like', likeMaybe',-  (.+.), (.-.), (./.), (.*.), negate', fromIntegral', showNum,-  (?+?), (?-?), (?/?), (?*?), negateMaybe, fromIntegralMaybe, showNumMaybe,+  negate', fromIntegral', showNum,+  negateMaybe, fromIntegralMaybe, showNumMaybe,++  casesOrElse, casesOrElse',+  caseSearch, caseSearchMaybe, case', caseMaybe,++  SqlBinOp, unsafeBinOp, unsafeUniOp,    -- * Terms for Window function types   rank, denseRank, rowNumber, percentRank, cumeDist,
test/Model.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -7,7 +8,7 @@ import Data.Int (Int32, Int64)  import Database.Relational.Query (defaultConfig)-import Database.Relational.Query.TH (defineTableDefault, makeRelationalRecordDefault)+import Database.Relational.Query.TH (defineTableDefault, makeRelationalRecordDefault, defineScalarDegree)   $(defineTableDefault defaultConfig "TEST" "set_a"@@ -53,3 +54,5 @@   }  $(makeRelationalRecordDefault ''Abc)++$(defineScalarDegree [t| Int32 |])
test/sqlsEq.hs view
@@ -10,31 +10,6 @@ import Database.Relational.Query  -numBin :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> Relation () r-numBin op = relation $ do-  return $ value 5 `op` value 3--strConcat :: Relation () String-strConcat = relation $ do-  return $ value "Hello, " .||. value "World!"--strLike :: Relation () (Maybe Bool)-strLike = relation $ do-  return $ 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"@@ -45,6 +20,102 @@ _p_tables :: IO () _p_tables =  mapM_ print [show setA, show setB, show setC] ++-- Monadic Operators tests++queryX :: Relation () SetA+queryX = relation $ do+  a <- query setA+  return a++queryMaybeX :: Relation () (Maybe SetA)+queryMaybeX = relation $ do+  a <- queryMaybe setA+  return a++onX :: Relation () (Maybe SetA, SetB)+onX = relation $ do+  a <- queryMaybe setA+  b <- query      setB+  on $ a ?! intA0' .=. just (b ! intB0')+  return $ (,) |$| a |*| b++wheresX :: Relation () (SetA, SetB)+wheresX = relation $ do+  a <- query      setA+  b <- query      setB+  wheres $ b ! intB0' .>=. value 3+  return $ (,) |$| a |*| b++groupByX :: Relation () (Int32, Integer)+groupByX = aggregateRelation $ do+  a <- query      setA+  ga0 <- groupBy $ a ! intA0'+  return $ (,) |$| ga0 |*| count (a ! intA0')++havingX :: Relation () Int+havingX = aggregateRelation $ do+  a <- query      setA+  let c = count (a ! intA0')+  having $ c .>. value 1+  return c++distinctX :: Relation () Int32+distinctX = relation $ do+  distinct+  a <- query      setA+  return $ a ! intA0'++all'X :: Relation () Int32+all'X = relation $ do+  all'+  a <- query      setA+  return $ a ! intA0'++assignX :: Update ()+assignX = derivedUpdate $ \_proj -> do+  intA0' <-# value (0 :: Int32)+  return unitPlaceHolder++monadic :: [Test]+monadic =+  [ eqProp "query"      queryX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2 FROM TEST.set_a T0"+  , eqProp "queryMaybe" queryMaybeX+    "SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2 FROM TEST.set_a T0"+  , eqProp "on"         onX+    "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 "wheres"     wheresX+    "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) \+    \ WHERE (T1.int_b0 >= 3)"+  , eqProp "groupBy"    groupByX+    "SELECT ALL T0.int_a0 AS f0, COUNT(T0.int_a0) AS f1 \+    \  FROM TEST.set_a T0 GROUP BY T0.int_a0"+  , eqProp "having"     havingX+    "SELECT ALL COUNT(T0.int_a0) AS f0 FROM TEST.set_a T0 HAVING (COUNT(T0.int_a0) > 1)"+  , eqProp "distinct"   distinctX+    "SELECT DISTINCT T0.int_a0 AS f0 FROM TEST.set_a T0"+  , eqProp "all'"       all'X+    "SELECT ALL T0.int_a0 AS f0 FROM TEST.set_a T0"+  , eqProp "update"      assignX+    "UPDATE TEST.set_a SET int_a0 = 0"+  ]++_p_monadic :: IO ()+_p_monadic =+  mapM_ putStrLn+  [ show queryX, show queryMaybeX, show onX, show wheresX+  , show groupByX, show havingX, show distinctX, show all'X+  , show assignX+  ]+++-- Direct Join Operators+ cross :: Relation () (SetA, SetB) cross =  setA `inner` setB `on'` [] @@ -130,6 +201,64 @@ _p_j3s :: IO () _p_j3s =  mapM_ print [show j3left, show j3right] ++-- Projection Operators++bin53 :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> Relation () r+bin53 op = relation $ do+  return $ value 5 `op` value 3++strIn :: Relation () (Maybe Bool)+strIn = relation $+  return $ value "foo" `in'` values ["foo", "bar"]++boolTF :: (Projection Flat (Maybe Bool) -> Projection Flat (Maybe Bool) -> Projection Flat r) -> Relation () r+boolTF op = relation $ do+  return $ valueTrue `op` valueFalse++strConcat :: Relation () String+strConcat = relation $ do+  return $ value "Hello, " .||. value "World!"++strLike :: Relation () (Maybe Bool)+strLike = relation $ do+  return $ value "Hoge" `like` "H%"++_p_bin53 :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> IO ()+_p_bin53 = print . bin53++bin :: [Test]+bin =+  [ eqProp "equal" (bin53 (.=.))  "SELECT ALL (5 =  3) AS f0"+  , eqProp "lt"    (bin53 (.<.))  "SELECT ALL (5 <  3) AS f0"+  , eqProp "le"    (bin53 (.<=.)) "SELECT ALL (5 <= 3) AS f0"+  , eqProp "gt"    (bin53 (.>.))  "SELECT ALL (5 >  3) AS f0"+  , eqProp "ge"    (bin53 (.>=.)) "SELECT ALL (5 >= 3) AS f0"+  , eqProp "ne"    (bin53 (.<>.)) "SELECT ALL (5 <> 3) AS f0"++  , eqProp "and"   (boolTF and')  "SELECT ALL ((0=0) AND (0=1)) AS f0"+  , eqProp "or"    (boolTF or')   "SELECT ALL ((0=0) OR  (0=1)) AS f0"++  , eqProp "in"    strIn          "SELECT ALL ('foo' IN ('foo', 'bar')) AS f0"++  , eqProp "string concat" strConcat "SELECT ALL ('Hello, ' || 'World!') AS f0"+  , eqProp "like" strLike "SELECT ALL ('Hoge' LIKE 'H%') AS f0"++  , eqProp "plus"  (bin53 (.+.)) "SELECT ALL (5 + 3) AS f0"+  , eqProp "minus" (bin53 (.-.)) "SELECT ALL (5 - 3) AS f0"+  , eqProp "mult"  (bin53 (.*.)) "SELECT ALL (5 * 3) AS f0"+  , eqProp "div"   (bin53 (./.)) "SELECT ALL (5 / 3) AS f0"+  ]++nothingX :: Relation () (SetA, Maybe SetB)+nothingX =  relation $ do+  a <- query setA+  b <- queryMaybe setB++  wheres $ isNothing b `or'` a ! intA0' .=. value 1++  return $ a >< b+ justX :: Relation () (SetA, Maybe SetB) justX =  relation $ do   a <- query setA@@ -148,21 +277,38 @@    return $ fromMaybe (value 1) (a ?! intA0') >< b -maybes :: [Test]-maybes =-  [ eqProp "isJust" justX+notX :: Relation () (Maybe Bool)+notX = relation $+  return $ not' valueFalse++existsX :: Relation () (Maybe Bool)+existsX = relation $+  return . exists =<< queryList setA++uni :: [Test]+uni =+  [ eqProp "isNothing" nothingX     "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 ((T1.int_b0 IS NULL) OR (T0.int_a0 = 1))"+  , 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)"+  , eqProp "not" notX+    "SELECT ALL (NOT (0=1)) AS f0"+  , eqProp "exists" existsX+    "SELECT ALL (EXISTS (SELECT int_a0, str_a1, str_a2 FROM TEST.set_a)) AS f0"   ] -_p_maybes :: IO ()-_p_maybes =  mapM_ print [show justX, show maybeX]+_p_uni :: IO ()+_p_uni =  mapM_ print [show nothingX, show justX, show maybeX, show notX, show existsX]  groupX :: Relation () (String, Int64) groupX =  aggregateRelation $ do@@ -359,10 +505,75 @@     "DELETE FROM TEST.set_a WHERE (str_a1 = 'A')"   ] +updateExistsX :: Update ()+updateExistsX = derivedUpdate $ \proj -> do+  strA2' <-# value "X"+  wheres . exists+    =<< (queryList . relation $ do+            b <- query setB+            wheres $ b ! intB0' .=. proj ! intA0'+            return b)+  return unitPlaceHolder++updateScalarX :: Update ()+updateScalarX = derivedUpdate $ \proj -> do+  strA2' <-# value "X"+  sb <- queryScalar . unsafeUnique . relation $ do+    b <- query setB+    wheres $ b ! intB0' .=. value 0+    return $ b ! intB0'+  wheres $ just (proj ! intA0') .=. sb+  return unitPlaceHolder++deleteExistsX :: Delete ()+deleteExistsX =  derivedDelete $ \proj -> do+  wheres . exists+    =<< (queryList . relation $ do+            b <- query setB+            wheres $ b ! intB0' .=. proj ! intA0'+            return b)+  return unitPlaceHolder++deleteScalarX :: Delete ()+deleteScalarX = derivedDelete $ \proj -> do+  sb <- queryScalar . unsafeUnique . relation $ do+    b <- query setB+    wheres $ b ! intB0' .=. value 0+    return $ b ! intB0'+  wheres $ just (proj ! intA0') .=. sb+  return unitPlaceHolder++correlated :: [Test]+correlated =+  [ eqProp "update-exists" updateExistsX+    "UPDATE TEST.set_a SET str_a2 = 'X' \+    \ WHERE (EXISTS (SELECT ALL T0.int_b0 AS f0, T0.may_str_b1 AS f1, T0.str_b2 AS f2 \+    \                      FROM TEST.set_b T0 \+    \                     WHERE (T0.int_b0 = int_a0)))"++  , eqProp "update-scalar" updateScalarX+    "UPDATE TEST.set_a SET str_a2 = 'X' \+    \ WHERE (int_a0 = (SELECT ALL T0.int_b0 AS f0 \+    \                        FROM TEST.set_b T0 \+    \                       WHERE (T0.int_b0 = 0)))"++  , eqProp "delete-exists" deleteExistsX+   "DELETE FROM TEST.set_a \+   \ WHERE (EXISTS (SELECT ALL T0.int_b0 AS f0, T0.may_str_b1 AS f1, T0.str_b2 AS f2 \+   \                      FROM TEST.set_b T0 \+   \                     WHERE (T0.int_b0 = int_a0)))"++  , eqProp "delete-scalar" deleteScalarX+    "DELETE FROM TEST.set_a \+    \ WHERE (int_a0 = (SELECT ALL T0.int_b0 AS f0 \+    \                        FROM TEST.set_b T0 \+    \                       WHERE (T0.int_b0 = 0)))"+  ]+ tests :: [Test] tests =-  concat [ bin, tables, directJoins, join3s, maybes-         , groups, orders, partitions, exps, effs]+  concat [ tables, monadic, directJoins, join3s, bin, uni+         , groups, orders, partitions, exps, effs, correlated]  main :: IO () main = defaultMain tests