relational-query 0.4.0.1 → 0.5.0.0
raw patch · 10 files changed
+115/−87 lines, 10 files
Files
- relational-query.cabal +1/−1
- src/Database/Relational/Query/Internal/SQL.hs +8/−4
- src/Database/Relational/Query/Projectable.hs +74/−73
- src/Database/Relational/Query/ProjectableExtended.hs +2/−3
- src/Database/Relational/Query/Projection.hs +2/−2
- src/Database/Relational/Query/Pure.hs +5/−0
- src/Database/Relational/Query/SQL.hs +3/−3
- src/Database/Relational/Query/TH.hs +1/−1
- test/Model.hs +4/−0
- test/SQLs.hs +15/−0
relational-query.cabal view
@@ -1,5 +1,5 @@ name: relational-query-version: 0.4.0.1+version: 0.5.0.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/Internal/SQL.hs view
@@ -13,7 +13,7 @@ rowStringSQL, rowPlaceHolderStringSQL, - rowListStringSQL,+ rowConsStringSQL, listStringSQL, ) where import Language.SQL.Keyword (Keyword, word, wordShow, fold, (|*|), paren)@@ -41,6 +41,10 @@ rowPlaceHolderStringSQL :: Int -> StringSQL rowPlaceHolderStringSQL = rowStringSQL . (`replicate` stringSQL "?") --- | Rows String of SQL.-rowListStringSQL :: [StringSQL] -> StringSQL-rowListStringSQL = paren . fold (|*|)+-- | List String of SQL.+rowConsStringSQL :: [StringSQL] -> StringSQL+rowConsStringSQL = paren . fold (|*|)++-- | List String of SQL.+listStringSQL :: [StringSQL] -> StringSQL+listStringSQL = paren . fold (|*|)
src/Database/Relational/Query/Projectable.hs view
@@ -45,18 +45,16 @@ caseSearch, caseSearchMaybe, case', caseMaybe, in', and', or', - isNothing, isJust, fromMaybe, fromMaybe',+ isNothing, isJust, fromMaybe, not', exists, - (.||.), (?||?),+ (.||.), (?||?), like, likeMaybe, like', likeMaybe', (.+.), (.-.), (./.), (.*.), negate', fromIntegral', showNum, (?+?), (?-?), (?/?), (?*?), negateMaybe, fromIntegralMaybe, showNumMaybe, -- * Terms for Window function types rank, denseRank, rowNumber, percentRank, cumeDist, - dense_rank, row_number, percent_rank, cume_dist,- -- * Zipping projections projectZip, (><), ProjectableIdZip (..),@@ -70,7 +68,6 @@ import Prelude hiding (pi) -import Data.Int (Int64) import Data.String (IsString) import Data.Monoid ((<>), mconcat) import Control.Applicative ((<$>))@@ -131,6 +128,12 @@ instance SqlProjectable (Expr p) where unsafeProjectSqlTerms' = UnsafeExpr.Expr . rowStringSQL +class SqlProjectable p => OperatorProjectable p+instance OperatorProjectable (Projection Flat)+instance OperatorProjectable (Projection Aggregated)+instance OperatorProjectable (Expr Flat)+instance OperatorProjectable (Expr Aggregated)+ -- | Unsafely Project single SQL term. unsafeProjectSql' :: SqlProjectable p => StringSQL -> p t unsafeProjectSql' = unsafeProjectSqlTerms' . (:[])@@ -140,23 +143,23 @@ unsafeProjectSql = unsafeProjectSql' . stringSQL -- | Polymorphic projection of SQL null value.-unsafeValueNull :: SqlProjectable p => p (Maybe a)+unsafeValueNull :: OperatorProjectable p => p (Maybe a) unsafeValueNull = unsafeProjectSql "NULL" -- | Generate polymorphic projection of SQL constant values from Haskell value.-value :: (ShowConstantTermsSQL t, SqlProjectable p) => t -> p t+value :: (ShowConstantTermsSQL t, OperatorProjectable p) => t -> p t value = unsafeProjectSqlTerms' . showConstantTermsSQL' -- | Polymorphic proejction of SQL true value.-valueTrue :: (SqlProjectable p, ProjectableMaybe p) => p (Maybe Bool)+valueTrue :: (OperatorProjectable p, ProjectableMaybe p) => p (Maybe Bool) valueTrue = just $ value True -- | Polymorphic proejction of SQL false value.-valueFalse :: (SqlProjectable p, ProjectableMaybe p) => p (Maybe Bool)+valueFalse :: (OperatorProjectable p, ProjectableMaybe p) => p (Maybe Bool) valueFalse = just $ value False -- | Polymorphic proejction of SQL set value from Haskell list.-values :: (ShowConstantTermsSQL t, SqlProjectable p) => [t] -> ListProjection p t+values :: (ShowConstantTermsSQL t, OperatorProjectable p) => [t] -> ListProjection p t values = Projection.list . map value @@ -215,93 +218,117 @@ -- | Compare operator corresponding SQL /=/ .-(.=.) :: (SqlProjectable p, ProjectableShowSql p)+(.=.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.=.) = compareBinOp (SQL..=.) -- | Compare operator corresponding SQL /</ .-(.<.) :: (SqlProjectable p, ProjectableShowSql p)+(.<.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.<.) = compareBinOp (SQL..<.) -- | Compare operator corresponding SQL /<=/ .-(.<=.) :: (SqlProjectable p, ProjectableShowSql p)+(.<=.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.<=.) = compareBinOp (SQL..<=.) -- | Compare operator corresponding SQL />/ .-(.>.) :: (SqlProjectable p, ProjectableShowSql p)+(.>.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.>.) = compareBinOp (SQL..>.) -- | Compare operator corresponding SQL />=/ .-(.>=.) :: (SqlProjectable p, ProjectableShowSql p)+(.>=.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.>=.) = compareBinOp (SQL..>=.) -- | Compare operator corresponding SQL /<>/ .-(.<>.) :: (SqlProjectable p, ProjectableShowSql p)+(.<>.) :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) (.<>.) = compareBinOp (SQL..<>.) -- | Logical operator corresponding SQL /AND/ .-and' :: (SqlProjectable p, ProjectableShowSql p)+and' :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) and' = compareBinOp SQL.and -- | Logical operator corresponding SQL /OR/ .-or' :: (SqlProjectable p, ProjectableShowSql p)+or' :: (OperatorProjectable p, ProjectableShowSql p) => p ft -> p ft -> p (Maybe Bool) or' = compareBinOp SQL.or -- | Logical operator corresponding SQL /NOT/ .-not' :: (SqlProjectable p, ProjectableShowSql p)+not' :: (OperatorProjectable p, ProjectableShowSql p) => p (Maybe Bool) -> p (Maybe Bool) not' = unsafeFlatUniOp SQL.NOT -- | Logical operator corresponding SQL /EXISTS/ .-exists :: (SqlProjectable p, ProjectableShowSql p)+exists :: (OperatorProjectable p, ProjectableShowSql p) => ListProjection (Projection Exists) r -> p (Maybe Bool) exists = unsafeProjectSql' . SQL.paren . SQL.defineUniOp SQL.EXISTS . Projection.unsafeStringSqlList unsafeShowSql' -- | Concatinate operator corresponding SQL /||/ .-(.||.) :: (SqlProjectable p, ProjectableShowSql p, IsString a)+(.||.) :: (OperatorProjectable p, ProjectableShowSql p, IsString a) => p a -> p a -> p a (.||.) = unsafeBinOp (SQL..||.) -- | Concatinate operator corresponding SQL /||/ . Maybe type version.-(?||?) :: (SqlProjectable p, ProjectableShowSql p, IsString a)+(?||?) :: (OperatorProjectable p, ProjectableShowSql p, IsString a) => p (Maybe a) -> p (Maybe a) -> p (Maybe a) (?||?) = unsafeBinOp (SQL..||.) +unsafeLike :: (OperatorProjectable p, ProjectableShowSql p)+ => p a -> p b -> p (Maybe Bool)+unsafeLike = unsafeBinOp (SQL.defineBinOp SQL.LIKE)++-- | String-compare operator corresponding SQL /LIKE/ .+like' :: (OperatorProjectable p, ProjectableShowSql p, IsString a)+ => p a -> p a -> p (Maybe Bool)+x `like'` y = x `unsafeLike` y++-- | String-compare operator corresponding SQL /LIKE/ .+likeMaybe' :: (OperatorProjectable p, ProjectableShowSql p, IsString a)+ => p (Maybe a) -> p (Maybe a) -> p (Maybe Bool)+x `likeMaybe'` y = x `unsafeLike` y++-- | String-compare operator corresponding SQL /LIKE/ .+like :: (OperatorProjectable p, ProjectableShowSql p, IsString a, ShowConstantTermsSQL a)+ => p a -> a -> p (Maybe Bool)+x `like` a = x `like'` value a++-- | String-compare operator corresponding SQL /LIKE/ . Maybe type version.+likeMaybe :: (OperatorProjectable p, ProjectableShowSql p, IsString a, ShowConstantTermsSQL a)+ => p (Maybe a) -> a -> p (Maybe Bool)+x `likeMaybe` a = x `unsafeLike` value a+ -- | Unsafely make number projection binary operator from SQL operator string. monoBinOp' :: (SqlProjectable p, ProjectableShowSql p) => Keyword -> p a -> p a -> p a monoBinOp' = monoBinOp . SQL.defineBinOp -- | Number operator corresponding SQL /+/ .-(.+.) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(.+.) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p a -> p a -> p a (.+.) = monoBinOp' "+" -- | Number operator corresponding SQL /-/ .-(.-.) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(.-.) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p a -> p a -> p a (.-.) = monoBinOp' "-" -- | Number operator corresponding SQL /// .-(./.) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(./.) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p a -> p a -> p a (./.) = monoBinOp' "/" -- | Number operator corresponding SQL /*/ .-(.*.) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(.*.) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p a -> p a -> p a (.*.) = monoBinOp' "*" -- | Number negate uni-operator corresponding SQL /-/.-negate' :: (SqlProjectable p, ProjectableShowSql p, Num a)+negate' :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p a -> p a negate' = unsafeFlatUniOp $ SQL.word "-" @@ -320,27 +347,27 @@ showNum = unsafeCastProjectable -- | Number operator corresponding SQL /+/ .-(?+?) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(?+?) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p (Maybe a) -> p (Maybe a) -> p (Maybe a) (?+?) = monoBinOp' "+" -- | Number operator corresponding SQL /-/ .-(?-?) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(?-?) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p (Maybe a) -> p (Maybe a) -> p (Maybe a) (?-?) = monoBinOp' "-" -- | Number operator corresponding SQL /// .-(?/?) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(?/?) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p (Maybe a) -> p (Maybe a) -> p (Maybe a) (?/?) = monoBinOp' "/" -- | Number operator corresponding SQL /*/ .-(?*?) :: (SqlProjectable p, ProjectableShowSql p, Num a)+(?*?) :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p (Maybe a) -> p (Maybe a) -> p (Maybe a) (?*?) = monoBinOp' "*" -- | Number negate uni-operator corresponding SQL /-/.-negateMaybe :: (SqlProjectable p, ProjectableShowSql p, Num a)+negateMaybe :: (OperatorProjectable p, ProjectableShowSql p, Num a) => p (Maybe a) -> p (Maybe a) negateMaybe = unsafeFlatUniOp $ SQL.word "-" @@ -354,7 +381,7 @@ => p (Maybe a) -> p (Maybe b) showNumMaybe = unsafeCastProjectable -whensClause :: (SqlProjectable p, ProjectableShowSql p)+whensClause :: (OperatorProjectable p, ProjectableShowSql p) => String -- ^ Error tag -> [(p a, p b)] -- ^ Each when clauses -> p b -- ^ Else result projection@@ -367,28 +394,28 @@ -- | Search case operator correnponding SQL search /CASE/. -- Like, /CASE WHEN p0 THEN a WHEN p1 THEN b ... ELSE c END/-caseSearch :: (SqlProjectable p, ProjectableShowSql p)+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 -- | Same as 'caseSearch', but you can write like <when list> `casesOrElse` <else clause>.-casesOrElse :: (SqlProjectable p, ProjectableShowSql p)+casesOrElse :: (OperatorProjectable p, ProjectableShowSql p) => [(p (Maybe Bool), p a)] -- ^ Each when clauses -> p a -- ^ Else result projection -> p a -- ^ Result projection casesOrElse = caseSearch -- | Null default version of 'caseSearch'.-caseSearchMaybe :: (ProjectableShowSql p, SqlProjectable p)+caseSearchMaybe :: (OperatorProjectable p, ProjectableShowSql p) => [(p (Maybe Bool), p (Maybe a))] -- ^ Each when clauses -> p (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' :: (SqlProjectable p, ProjectableShowSql p)+case' :: (OperatorProjectable p, ProjectableShowSql p) => p a -- ^ Projection value to match -> [(p a, p b)] -- ^ Each when clauses -> p b -- ^ Else result projection@@ -396,91 +423,65 @@ case' v cs e = unsafeProjectSql' $ SQL.CASE <> unsafeShowSql' v <> whensClause "case'" cs e -- | Uncurry version of 'case'', and you can write like ... `casesOrElse'` <else clause>.-casesOrElse' :: (SqlProjectable p, ProjectableShowSql p)+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' = uncurry case' -- | Null default version of 'case''.-caseMaybe :: (SqlProjectable p, ProjectableShowSql p, ProjectableMaybe p)+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 v cs = case' v cs unsafeValueNull -- | Binary operator corresponding SQL /IN/ .-in' :: (SqlProjectable p, ProjectableShowSql p)+in' :: (OperatorProjectable p, ProjectableShowSql p) => p t -> ListProjection p t -> p (Maybe Bool) in' a lp = unsafeProjectSql' . SQL.paren $ SQL.in' (unsafeShowSql' a) (Projection.unsafeStringSqlList unsafeShowSql' lp) -- | Operator corresponding SQL /IS NULL/ , and extended against record types.-isNothing :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r)+isNothing :: (OperatorProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r) => Projection c (Maybe r) -> Projection c (Maybe Bool) isNothing mr = unsafeProjectSql' $ SQL.paren $ (SQL.defineBinOp SQL.IS) (Projection.unsafeStringSqlNotNullMaybe mr) SQL.NULL -- | Operator corresponding SQL /NOT (... IS NULL)/ , and extended against record type.-isJust :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r)+isJust :: (OperatorProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r) => Projection c (Maybe r) -> Projection c (Maybe Bool) isJust = not' . isNothing -- | Operator from maybe type using record extended 'isNull'.-fromMaybe :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r)+fromMaybe :: (OperatorProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r) => Projection c r -> Projection c (Maybe r) -> Projection c r fromMaybe d p = [ (isNothing p, d) ] `casesOrElse` unsafeCastProjectable p --- | Deprecated. Operator from maybe type using record extended 'isNull'.-fromMaybe' :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c), HasColumnConstraint NotNull r)- => Projection c r -> Projection c (Maybe r) -> Projection c r-fromMaybe' = fromMaybe-{-# DEPRECATED fromMaybe' "Use fromMaybe instead of this." #-}- unsafeUniTermFunction :: SqlProjectable p => Keyword -> p t unsafeUniTermFunction = unsafeProjectSql' . (SQL.<++> stringSQL "()") -- | /RANK()/ term.-rank :: Projection OverWindow Int64+rank :: Integral a => Projection OverWindow a rank = unsafeUniTermFunction SQL.RANK -- | /DENSE_RANK()/ term.-denseRank :: Projection OverWindow Int64+denseRank :: Integral a => Projection OverWindow a denseRank = unsafeUniTermFunction SQL.DENSE_RANK --- | /DENSE_RANK()/ term.-dense_rank :: Projection OverWindow Int64-dense_rank = denseRank-{-# DEPRECATED dense_rank "Use denseRank instead of this." #-}- -- | /ROW_NUMBER()/ term.-rowNumber :: Projection OverWindow Int64+rowNumber :: Integral a => Projection OverWindow a rowNumber = unsafeUniTermFunction SQL.ROW_NUMBER --- | /ROW_NUMBER()/ term.-row_number :: Projection OverWindow Int64-row_number = rowNumber-{-# DEPRECATED row_number "Use rowNumber instead of this." #-}- -- | /PERCENT_RANK()/ term. percentRank :: Projection OverWindow Double percentRank = unsafeUniTermFunction SQL.PERCENT_RANK --- | /PERCENT_RANK()/ term.-percent_rank :: Projection OverWindow Double-percent_rank = percentRank-{-# DEPRECATED percent_rank "Use percentRank instead of this." #-}- -- | /CUME_DIST()/ term. cumeDist :: Projection OverWindow Double cumeDist = unsafeUniTermFunction SQL.CUME_DIST --- | /CUME_DIST()/ term.-cume_dist :: Projection OverWindow Double-cume_dist = cumeDist-{-# DEPRECATED cume_dist "Use cumeDist instead of this." #-}- -- | Placeholder parameter type which has real parameter type arguemnt 'p'. data PlaceHolders p = PlaceHolders @@ -603,7 +604,7 @@ infixl 6 .+., .-., ?+?, ?-? infixl 5 .||., ?||? infixl 4 |$|, |*|-infix 4 .=., .<>., .>., .>=., .<., .<=., `in'`+infix 4 .=., .<>., .>., .>=., .<., .<=., `in'`, `like`, `likeMaybe`, `like'`, `likeMaybe'` infixr 3 `and'` infixr 2 `or'` infixl 1 ><
src/Database/Relational/Query/ProjectableExtended.hs view
@@ -38,7 +38,6 @@ ) where import Prelude hiding (pi)-import Data.Int (Int64) import qualified Language.SQL.Keyword as SQL @@ -69,8 +68,8 @@ unsafeAggregateOp op = unsafeUniOp ((op SQL.<++>) . SQL.paren) -- | Aggregation function COUNT.-count :: (AggregatedContext ac, SqlProjectable (p ac))- => Projection Flat a -> p ac Int64+count :: (Integral b, AggregatedContext ac, SqlProjectable (p ac))+ => Projection Flat a -> p ac b count = unsafeAggregateOp SQL.COUNT -- | Aggregation function SUM.
src/Database/Relational/Query/Projection.hs view
@@ -48,7 +48,7 @@ import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint) import qualified Database.Record.KeyConstraint as KeyConstraint -import Database.Relational.Query.Internal.SQL (StringSQL, rowStringSQL, rowListStringSQL)+import Database.Relational.Query.Internal.SQL (StringSQL, rowStringSQL, listStringSQL) import Database.Relational.Query.Context (Aggregated, Flat) import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, columnSQL') import Database.Relational.Query.Table (Table)@@ -197,5 +197,5 @@ -- | Map projection show operatoions and concatinate to single SQL expression. unsafeStringSqlList :: (p t -> StringSQL) -> ListProjection p t -> StringSQL unsafeStringSqlList sf = d where- d (List ps) = rowListStringSQL $ map sf ps+ d (List ps) = listStringSQL $ map sf ps d (Sub sub) = SQL.paren $ SubQuery.showSQL sub
src/Database/Relational/Query/Pure.hs view
@@ -91,6 +91,11 @@ instance ShowConstantTermsSQL Int64 where showConstantTermsSQL' = intTermsSQL +-- | Constant SQL terms of 'Int'.+-- Use this carefully, because this is architecture dependent size of integer type.+instance ShowConstantTermsSQL Int where+ showConstantTermsSQL' = intTermsSQL+ -- | Constant SQL terms of 'String'. instance ShowConstantTermsSQL String where showConstantTermsSQL' = stringTermsSQL
src/Database/Relational/Query/SQL.hs view
@@ -34,7 +34,7 @@ import Database.Record.ToSql (untypedUpdateValuesIndex) -import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL, rowStringSQL)+import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL, rowConsStringSQL) import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, showsColumnSQL)@@ -94,7 +94,7 @@ -- | Generate prefix string of insert SQL. insertPrefixSQL :: Pi r r' -> Table r -> StringSQL insertPrefixSQL pi' table =- INSERT <> INTO <> stringSQL (name table) <> rowStringSQL [showsColumnSQL c | c <- cols] where+ INSERT <> INTO <> stringSQL (name table) <> rowConsStringSQL [showsColumnSQL c | c <- cols] where cols = Projection.columns . Projection.pi (Projection.unsafeFromTable table) $ pi' -- | Generate records chunk insert SQL.@@ -106,7 +106,7 @@ n | n0 >= 1 = n0 | otherwise = error $ "Invalid chunk count value: " ++ show n0 w = UnsafePi.width pi'- vs = SQL.fold (|*|) . replicate n $ rowStringSQL (replicate w "?")+ vs = SQL.fold (|*|) . replicate n $ rowConsStringSQL (replicate w "?") -- | Generate size measured records chunk insert SQL. insertSizedChunkSQL :: Pi r r' -- ^ Columns selector to insert
src/Database/Relational/Query/TH.hs view
@@ -436,7 +436,7 @@ -- | Generate all templates against defined record like type constructor -- other than depending on sql-value type. makeRelationalRecordDefault :: Name -- ^ Type constructor name- -> Q [Dec] -- ^ Resutl declaration+ -> Q [Dec] -- ^ Result declaration makeRelationalRecordDefault recTypeName = do let recTypeConName = ConName recTypeName ((tyCon, dataCon), (mayNs, cts)) <- Record.reifyRecordType recTypeName
test/Model.hs view
@@ -32,6 +32,10 @@ [] [0] $ Just 0) +$(defineTableDefault defaultConfig "TEST" "set_i"+ [ ("int_i0" , [t| Int32 |]) ]+ [] [0] $ Just 0)+ data ABC = ABC { xJustA :: SetA
test/SQLs.hs view
@@ -16,6 +16,14 @@ 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 @@ -25,6 +33,8 @@ , 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]@@ -279,6 +289,9 @@ insertX :: Insert SetA insertX = derivedInsert id' +insertI :: Insert SetI+insertI = derivedInsert id'+ insertQueryX :: InsertQuery () insertQueryX = derivedInsertQuery setAFromB setA @@ -300,6 +313,8 @@ 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