relational-query 0.9.0.1 → 0.9.0.2

raw patch · 7 files changed

+159/−41 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• relational-query.cabal +1/−1
• src/Database/Relational/Query/Internal/Sub.hs +46/−0
• src/Database/Relational/Query/Projectable.hs +27/−38
• src/Database/Relational/Query/ProjectableClass.hs +17/−1
• src/Database/Relational/Query/Sub.hs +17/−0
• test/sqlsEq.hs +47/−1

@@ -1,5 +1,9 @@ <!-- -*- Markdown -*- --> +## 0.9.0.2++- Bugfix of case projected record. ( https://github.com/khibino/haskell-relational-record/issues/54 )+ ## 0.9.0.1  - Use Haskell implementation test instead of flag test in .cabal

@@ -1,5 +1,5 @@ name:                relational-query-version:             0.9.0.1+version:             0.9.0.2 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can

@@ -21,6 +21,9 @@        , JoinProduct, QueryProductTree        , ProductTreeBuilder, ProductBuilder +       , CaseClause (..), WhenClauses(..)+       , caseSearch, case'+        , UntypedProjection, untypedProjectionWidth, ProjectionUnit (..)        , Projection, untypeProjection, typedProjection, projectionWidth        , projectFromColumns, projectFromScalarSubQuery@@ -116,12 +119,23 @@ -- | Type for join product of query. type JoinProduct = Maybe QueryProductTree +-- | when clauses+data WhenClauses =+  WhenClauses [(UntypedProjection, UntypedProjection)] UntypedProjection+  deriving Show +-- | case clause+data CaseClause+  = CaseSearch WhenClauses+  | CaseSimple UntypedProjection WhenClauses+  deriving Show+ -- | Projection structure unit with single column width data ProjectionUnit   = RawColumn StringSQL            -- ^ used in immediate value or unsafe operations   | SubQueryRef (Qualified Int)    -- ^ normalized sub-query reference T<n> with Int index   | Scalar SubQuery                -- ^ scalar sub-query+  | Case CaseClause Int            -- ^ <n>th column of case clause   deriving Show  -- | Untyped projection. Forgot record type.@@ -152,6 +166,38 @@ -- | Unsafely generate 'Projection' from scalar sub-query. projectFromScalarSubQuery :: SubQuery -> Projection c t projectFromScalarSubQuery = typedProjection . (:[]) . Scalar++whenClauses :: String                             -- ^ Error tag+            -> [(Projection c a, Projection c b)] -- ^ Each when clauses+            -> Projection c b                     -- ^ Else result projection+            -> WhenClauses                        -- ^ Result clause+whenClauses eTag ws0 e = d ws0+  where+    d []       = error $ eTag ++ ": Empty when clauses!"+    d ws@(_:_) =+      WhenClauses [ (untypeProjection p, untypeProjection r) | (p, r) <- ws ]+      $ untypeProjection e++-- | Search case operator correnponding SQL search /CASE/.+--   Like, /CASE WHEN p0 THEN a WHEN p1 THEN b ... ELSE c END/+caseSearch :: [(Projection c (Maybe Bool), Projection c a)] -- ^ Each when clauses+           -> Projection c a                                -- ^ Else result projection+           -> Projection c a                                -- ^ Result projection+caseSearch ws e =+    typedProjection [ Case c i | i <- [0 .. projectionWidth e - 1] ]+  where+    c = CaseSearch $ whenClauses "caseSearch" ws e++-- | Simple case operator correnponding SQL simple /CASE/.+--   Like, /CASE x WHEN v THEN a WHEN w THEN b ... ELSE c END/+case' :: Projection c a                     -- ^ Projection value to match+      -> [(Projection c a, Projection c b)] -- ^ Each when clauses+      -> Projection c b                     -- ^ Else result projection+      -> Projection c b                     -- ^ Result projection+case' v ws e =+    typedProjection [ Case c i | i <- [0 .. projectionWidth e - 1] ]+  where+    c = CaseSimple (untypeProjection v) $ whenClauses "case'" ws e   -- | Type for restriction of query.

@@ -64,7 +64,6 @@ import Prelude hiding (pi)  import Data.String (IsString)-import Data.Monoid ((<>), mconcat) import Control.Applicative ((<$>))  import Language.SQL.Keyword (Keyword)@@ -75,6 +74,7 @@    HasColumnConstraint, NotNull)  import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL)+import qualified Database.Relational.Query.Internal.Sub as Internal  import Database.Relational.Query.ProjectableClass   (ProjectableFunctor (..), ProjectableApplicative (..), )@@ -352,59 +352,48 @@                    => p (Maybe a) -> p (Maybe b) showNumMaybe = unsafeCastProjectable -whensClause :: (OperatorProjectable p, ProjectableShowSql p)-            => String       -- ^ Error tag-            -> [(p a, p b)] -- ^ Each when clauses-            -> p b          -- ^ Else result projection-            -> Keyword      -- ^ Result projection-whensClause eTag cs0 e = d cs0  where-  d []       = error $ eTag ++ ": Empty when clauses!"-  d cs@(_:_) = mconcat [when' p r | (p, r) <- cs] <> else' <> SQL.END-  when' p r = SQL.WHEN <> unsafeShowSql' p <> SQL.THEN <> unsafeShowSql' r-  else'     = SQL.ELSE <> unsafeShowSql' e- -- | Search case operator correnponding SQL search /CASE/. --   Like, /CASE WHEN p0 THEN a WHEN p1 THEN b ... ELSE c END/-caseSearch :: (OperatorProjectable p, ProjectableShowSql p)-           => [(p (Maybe Bool), p a)] -- ^ Each when clauses-           -> p a                     -- ^ Else result projection-           -> p a                     -- ^ Result projection-caseSearch cs e = unsafeProjectSql' $ SQL.CASE <> whensClause "caseSearch" cs e+caseSearch :: OperatorProjectable (Projection c)+           => [(Projection c (Maybe Bool), Projection c a)] -- ^ Each when clauses+           -> Projection c a                                -- ^ Else result projection+           -> Projection c a                                -- ^ Result projection+caseSearch = Internal.caseSearch  -- | Same as 'caseSearch', but you can write like <when list> `casesOrElse` <else clause>.-casesOrElse :: (OperatorProjectable p, ProjectableShowSql p)-            => [(p (Maybe Bool), p a)] -- ^ Each when clauses-            -> p a                     -- ^ Else result projection-            -> p a                     -- ^ Result projection+casesOrElse :: OperatorProjectable (Projection c)+            => [(Projection c (Maybe Bool), Projection c a)] -- ^ Each when clauses+            -> Projection c a                                -- ^ Else result projection+            -> Projection c a                                -- ^ Result projection casesOrElse = caseSearch  -- | Null default version of 'caseSearch'.-caseSearchMaybe :: (OperatorProjectable p, ProjectableShowSql p)-                => [(p (Maybe Bool), p (Maybe a))] -- ^ Each when clauses-                -> p (Maybe a)                     -- ^ Result projection+caseSearchMaybe :: OperatorProjectable (Projection c) -- (Projection c) is always ProjectableMaybe+                => [(Projection c (Maybe Bool), Projection c (Maybe a))] -- ^ Each when clauses+                -> Projection c (Maybe a)                                -- ^ Result projection caseSearchMaybe cs = caseSearch cs unsafeValueNull  -- | Simple case operator correnponding SQL simple /CASE/. --   Like, /CASE x WHEN v THEN a WHEN w THEN b ... ELSE c END/-case' :: (OperatorProjectable p, ProjectableShowSql p)-      => p a          -- ^ Projection value to match-      -> [(p a, p b)] -- ^ Each when clauses-      -> p b          -- ^ Else result projection-      -> p b          -- ^ Result projection-case' v cs e = unsafeProjectSql' $ SQL.CASE <> unsafeShowSql' v <> whensClause "case'" cs e+case' :: OperatorProjectable (Projection c)+      => Projection c a                     -- ^ Projection value to match+      -> [(Projection c a, Projection c b)] -- ^ Each when clauses+      -> Projection c b                     -- ^ Else result projection+      -> Projection c b                     -- ^ Result projection+case' = Internal.case'  -- | Uncurry version of 'case'', and you can write like ... `casesOrElse'` <else clause>.-casesOrElse' :: (OperatorProjectable p, ProjectableShowSql p)-             => (p a, [(p a, p b)]) -- ^ Projection value to match and each when clauses list-             -> p b                 -- ^ Else result projection-             -> p b                 -- ^ Result projection+casesOrElse' :: OperatorProjectable (Projection c)+             => (Projection c a, [(Projection c a, Projection c b)]) -- ^ Projection value to match and each when clauses list+             -> Projection c b                                       -- ^ Else result projection+             -> Projection c b                                       -- ^ Result projection casesOrElse' =  uncurry case'  -- | Null default version of 'case''.-caseMaybe :: (OperatorProjectable p, ProjectableShowSql p, ProjectableMaybe p)-          => p a                  -- ^ Projection value to match-          -> [(p a, p (Maybe b))] -- ^ Each when clauses-          -> p (Maybe b)          -- ^ Result projection+caseMaybe :: OperatorProjectable (Projection c) -- (Projection c) is always ProjectableMaybe+          => Projection c a                             -- ^ Projection value to match+          -> [(Projection c a, Projection c (Maybe b))] -- ^ Each when clauses+          -> Projection c (Maybe b)                     -- ^ Result projection caseMaybe v cs = case' v cs unsafeValueNull  -- | Binary operator corresponding SQL /IN/ .

@@ -61,7 +61,23 @@                      -> [StringSQL] showConstantTermsSQL = toList . showConstantTermsSQL' --- | Interface for constant SQL term list.+{- |+'ShowConstantTermsSQL' 'a' is implicit rule to derive function to convert+from haskell record type 'a' into constant SQL terms.++Generic programming (<https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming>)+with default signature is available for 'ShowConstantTermsSQL' class,+so you can make instance like below:++@+  \{\-\# LANGUAGE DeriveGeneric \#\-\}+  import GHC.Generics (Generic)+  --+  data Foo = Foo { ... } deriving Generic+  instance ShowConstantTermsSQL Foo+@++-} class ShowConstantTermsSQL a where   showConstantTermsSQL' :: a -> DList StringSQL 

@@ -58,6 +58,7 @@   (AggregateElem, composeGroupBy, ) import Database.Relational.Query.Internal.Sub   (SubQuery (..), Projection,+   CaseClause(..), WhenClauses (..),    UntypedProjection, ProjectionUnit (..),    JoinProduct, QueryProductTree, ProductBuilder,    NodeAttr (Just', Maybe), ProductTree (Leaf, Join),@@ -243,12 +244,28 @@   d (Flat {})               =  normalized   d (Aggregated {})         =  normalized +-- | index result of each when clause and else clause.+indexWhensClause :: WhenClauses -> Int -> StringSQL+indexWhensClause (WhenClauses ps e) i =+    mconcat [ when' p r | (p, r)  <-  ps] <> else' <> SQL.END+  where+    when' p r = SQL.WHEN <> rowStringSQL (map columnOfProjectionUnit p) <>+                SQL.THEN <> columnOfUntypedProjection r i+    else'     = SQL.ELSE <> columnOfUntypedProjection e i++-- | index result of each when clause and else clause.+caseClause :: CaseClause -> Int -> StringSQL+caseClause c i = d c  where+  d (CaseSearch wcl)    = SQL.CASE <> indexWhensClause wcl i+  d (CaseSimple m wcl)  = SQL.CASE <> rowStringSQL (map columnOfProjectionUnit m) <> indexWhensClause wcl i+ -- | Convert from ProjectionUnit into column. columnOfProjectionUnit :: ProjectionUnit -> StringSQL columnOfProjectionUnit = d  where   d (RawColumn e)     = e   d (SubQueryRef qi)  = Internal.qualifier qi `columnFromId` Internal.unQualify qi   d (Scalar sub)      = showUnitSQL sub+  d (Case c i)        = caseClause c i  -- | Get column SQL string of 'UntypedProjection'. columnOfUntypedProjection :: UntypedProjection -- ^ Source 'Projection'

@@ -308,6 +308,52 @@   , eqProp "div"   (bin53 (./.)) "SELECT ALL (5 / 3) AS f0"   ] +caseSearchX :: Relation () String+caseSearchX = relation $ do+  return $+    caseSearch+    [ (value 2 .=. value (1  :: Int32)            , value "foo")+    , (value 5 .=. value 3 .+. value (2 :: Int32) , value "bar")+    , (value "a" .=. value "b"                    , value "baz") ]+    (value "other")++caseX :: Relation () String+caseX = relation $ do+  return $+    case'+    (value (5 :: Int32))+    [ (value 1             , value "foo")+    , (value 3 .+. value 2 , value "bar")+    , (value 10            , value "baz") ]+    (value "other")++caseRecordX :: Relation () Int32+caseRecordX = relation $ do+  return $+    case'+    (value (5 :: Int32))+    [ (value 1             , (,) |$| value 1 |*| value "foo")+    , (value 3 .+. value 2 , (,) |$| value 2 |*| value "bar")+    , (value 10            , (,) |$| value 3 |*| value "baz") ]+    ((,) |$| value (0 :: Int32) |*| value "other")+    ! fst'+    .*.+    value 10++cases :: [Test]+cases =+  [ eqProp "caseSearch" caseSearchX+    "SELECT ALL CASE WHEN (2 = 1) THEN 'foo' WHEN (5 = (3 + 2)) THEN 'bar' WHEN ('a' = 'b') THEN 'baz' ELSE 'other' END AS f0"+  , eqProp "case"       caseX+    "SELECT ALL CASE 5 WHEN 1 THEN 'foo' WHEN (3 + 2) THEN 'bar' WHEN 10 THEN 'baz' ELSE 'other' END AS f0"+  , eqProp "caseRecord" caseRecordX+    "SELECT ALL (CASE 5 WHEN 1 THEN 1 WHEN (3 + 2) THEN 2 WHEN 10 THEN 3 ELSE 0 END * 10) AS f0"+  ]++_p_cases :: IO ()+_p_cases =+  mapM_ print [show caseSearchX, show caseX]+ nothingX :: Relation () (SetA, Maybe SetB) nothingX =  relation $ do   a <- query setA@@ -630,7 +676,7 @@  tests :: [Test] tests =-  concat [ tables, monadic, directJoins, join3s, nested, bin, uni+  concat [ tables, monadic, directJoins, join3s, nested, bin, cases, uni          , groups, orders, partitions, exps, effs, correlated]  main :: IO ()