packages feed

relational-query 0.3.0.4 → 0.4.0.0

raw patch · 13 files changed

+157/−150 lines, 13 files

Files

relational-query.cabal view
@@ -1,5 +1,5 @@ name:                relational-query-version:             0.3.0.4+version:             0.4.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/Component.hs view
@@ -53,7 +53,7 @@  import qualified Database.Relational.Query.Context as Context import Database.Relational.Query.Expr (Expr, exprAnd)-import Database.Relational.Query.Expr.Unsafe (sqlExpr)+import Database.Relational.Query.Expr.Unsafe (unsafeStringSql)  import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL) import Language.SQL.Keyword (Keyword(..), (|*|), (.=.))@@ -126,7 +126,7 @@ composeRestrict :: Keyword -> QueryRestriction c -> StringSQL composeRestrict k = d  where   d    []    =  mempty-  d e@(_:_)  =  k <> sqlExpr (foldr1 exprAnd e)+  d e@(_:_)  =  k <> unsafeStringSql (foldr1 exprAnd e)  -- | Compose WHERE clause from 'QueryRestriction'. composeWhere :: QueryRestriction Context.Flat -> StringSQL
src/Database/Relational/Query/Expr.hs view
@@ -25,20 +25,20 @@  import Prelude hiding (and, or) -import Database.Relational.Query.Expr.Unsafe (Expr(Expr), sqlExpr)-import Database.Relational.Query.Pure (ShowConstantTermsSQL (showConstantTermsSQL))-import Database.Relational.Query.Internal.SQL (stringSQL, rowStringSQL)+import Database.Relational.Query.Expr.Unsafe (Expr(Expr), unsafeStringSql)+import Database.Relational.Query.Pure (ShowConstantTermsSQL, showConstantTermsSQL')+import Database.Relational.Query.Internal.SQL (rowStringSQL)  import qualified Language.SQL.Keyword as SQL   -- | Typed constant SQL expression from Haskell value. valueExpr :: ShowConstantTermsSQL ft => ft -> Expr p ft-valueExpr =  Expr . rowStringSQL . map stringSQL . showConstantTermsSQL+valueExpr =  Expr . rowStringSQL . showConstantTermsSQL'  -- | Unsafely cast phantom type. unsafeCastExpr :: Expr p a -> Expr p b-unsafeCastExpr =  Expr . sqlExpr+unsafeCastExpr =  Expr . unsafeStringSql  -- | Convert phantom type into 'Maybe'. just :: Expr p ft -> Expr p (Maybe ft)@@ -52,4 +52,4 @@  -- | AND operator for 'Expr'. exprAnd :: Expr p Bool -> Expr p Bool -> Expr p Bool-exprAnd a b = Expr . SQL.paren $ SQL.and (sqlExpr a) (sqlExpr b)+exprAnd a b = Expr . SQL.paren $ SQL.and (unsafeStringSql a) (unsafeStringSql b)
src/Database/Relational/Query/Expr/Unsafe.hs view
@@ -11,7 +11,7 @@ -- Contains internal structure and unsafe interfaces. module Database.Relational.Query.Expr.Unsafe (   -- * Typed SQL Expression-  Expr(Expr), sqlExpr, showExpr+  Expr(Expr), unsafeStringSql, showExpr   ) where  import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL)@@ -20,12 +20,12 @@ newtype Expr p a = Expr StringSQL  -- | Get SQL expression from typed object.-sqlExpr :: Expr p t -> StringSQL-sqlExpr (Expr s) = s+unsafeStringSql :: Expr p t -> StringSQL+unsafeStringSql (Expr s) = s  -- | Get SQL string from typed object. showExpr :: Expr p t -> String-showExpr =  showStringSQL . sqlExpr+showExpr =  showStringSQL . unsafeStringSql  -- | Show expression. instance Show (Expr p a) where
src/Database/Relational/Query/Internal/SQL.hs view
@@ -13,7 +13,7 @@    rowStringSQL, rowPlaceHolderStringSQL, -  rowListStringSQL, rowListStringString+  rowListStringSQL,   ) where  import Language.SQL.Keyword (Keyword, word, wordShow, fold, (|*|), paren)@@ -44,7 +44,3 @@ -- | Rows String of SQL. rowListStringSQL :: [StringSQL] -> StringSQL rowListStringSQL =  paren . fold (|*|)---- | Rows String of SQL. String type version.-rowListStringString :: [String] -> String-rowListStringString =  wordShow . rowListStringSQL . map word
src/Database/Relational/Query/Projectable.hs view
@@ -17,7 +17,8 @@   expr,    -- * Projectable from SQL strings-  SqlProjectable (unsafeProjectSqlTerms), unsafeProjectSql,+  SqlProjectable (unsafeProjectSqlTerms'), unsafeProjectSql',+  unsafeProjectSqlTerms, unsafeProjectSql,    -- * Projections of values   value,@@ -30,9 +31,7 @@   placeholder', placeholder, unitPlaceHolder,    -- * Projectable into SQL strings-  unsafeShowSqlExpr,-  unsafeShowSqlProjection,-  ProjectableShowSql (unsafeShowSql),+  ProjectableShowSql (unsafeShowSql'), unsafeShowSql,    -- * Operators   SqlBinOp,@@ -83,66 +82,62 @@   (PersistableWidth, PersistableRecordWidth, derivedWidth,    HasColumnConstraint, NotNull) -import Database.Relational.Query.Internal.SQL (stringSQL, showStringSQL, rowStringSQL)+import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL, rowStringSQL) import Database.Relational.Query.Context (Flat, Aggregated, Exists, OverWindow)-import Database.Relational.Query.Component (columnSQL, showsColumnSQL) import Database.Relational.Query.Expr (Expr) import qualified Database.Relational.Query.Expr as Expr import qualified Database.Relational.Query.Expr.Unsafe as UnsafeExpr  import Database.Relational.Query.Pure-  (ShowConstantTermsSQL (showConstantTermsSQL), ProductConstructor (..))+  (ShowConstantTermsSQL, showConstantTermsSQL', ProductConstructor (..)) import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi as Pi  import Database.Relational.Query.Projection-  (Projection, unsafeFromColumns, columns,-   ListProjection, unsafeShowSqlListProjection)+  (Projection, ListProjection) import qualified Database.Relational.Query.Projection as Projection  --- | Unsafely get SQL term from 'Proejction'.-unsafeShowSqlProjection :: Projection c r -> String-unsafeShowSqlProjection =  showStringSQL . rowStringSQL . map showsColumnSQL . columns---- | 'Expr' from 'Projection'-exprOfProjection :: Projection c r -> Expr c r-exprOfProjection =  UnsafeExpr.Expr . stringSQL . unsafeShowSqlProjection- -- | Project from Projection type into expression type. expr :: Projection p a -> Expr p a-expr =  exprOfProjection+expr =  UnsafeExpr.Expr . Projection.unsafeStringSql  --- | Unsafely generate 'Projection' from SQL expression strings.-unsafeSqlTermsProjection :: [String] -> Projection c t-unsafeSqlTermsProjection =  unsafeFromColumns . map columnSQL- -- | Interface to project SQL terms unsafely. class SqlProjectable p where-  -- | Unsafely project from SQL expression strings.-  unsafeProjectSqlTerms :: [String] -- ^ SQL expression strings-                        -> p t      -- ^ Result projection object+  -- | Unsafely project from SQL expression terms.+  unsafeProjectSqlTerms' :: [StringSQL] -- ^ SQL expression strings+                         -> p t         -- ^ Result projection object +-- | Unsafely project from SQL strings. String interface of 'unsafeProjectSqlTerms''.+unsafeProjectSqlTerms :: SqlProjectable p+                      => [String] -- ^ SQL expression strings+                      -> p t      -- ^ Result projection object+unsafeProjectSqlTerms =  unsafeProjectSqlTerms' . map stringSQL+ -- | Unsafely make 'Projection' from SQL terms. instance SqlProjectable (Projection Flat) where-  unsafeProjectSqlTerms = unsafeSqlTermsProjection+  unsafeProjectSqlTerms' = Projection.unsafeFromSqlTerms  -- | Unsafely make 'Projection' from SQL terms. instance SqlProjectable (Projection Aggregated) where-  unsafeProjectSqlTerms = unsafeSqlTermsProjection+  unsafeProjectSqlTerms' = Projection.unsafeFromSqlTerms  -- | Unsafely make 'Projection' from SQL terms. instance SqlProjectable (Projection OverWindow) where-  unsafeProjectSqlTerms = unsafeSqlTermsProjection+  unsafeProjectSqlTerms' = Projection.unsafeFromSqlTerms  -- | Unsafely make 'Expr' from SQL terms. instance SqlProjectable (Expr p) where-  unsafeProjectSqlTerms = UnsafeExpr.Expr . rowStringSQL . map stringSQL+  unsafeProjectSqlTerms' = UnsafeExpr.Expr . rowStringSQL  -- | Unsafely Project single SQL term.+unsafeProjectSql' :: SqlProjectable p => StringSQL -> p t+unsafeProjectSql' =  unsafeProjectSqlTerms' . (:[])++-- | Unsafely Project single SQL string. String interface of 'unsafeProjectSql''. unsafeProjectSql :: SqlProjectable p => String -> p t-unsafeProjectSql =  unsafeProjectSqlTerms . (:[])+unsafeProjectSql =  unsafeProjectSql' . stringSQL  -- | Polymorphic projection of SQL null value. unsafeValueNull :: SqlProjectable p => p (Maybe a)@@ -150,7 +145,7 @@  -- | Generate polymorphic projection of SQL constant values from Haskell value. value :: (ShowConstantTermsSQL t, SqlProjectable p) => t -> p t-value =  unsafeProjectSqlTerms . showConstantTermsSQL+value =  unsafeProjectSqlTerms' . showConstantTermsSQL'  -- | Polymorphic proejction of SQL true value. valueTrue  :: (SqlProjectable p, ProjectableMaybe p) => p (Maybe Bool)@@ -167,21 +162,24 @@  -- | Interface to get SQL term from projections. class ProjectableShowSql p where-  -- | Unsafely generate SQL expression string from projection object.-  unsafeShowSql :: p a    -- ^ Source projection object-                -> String -- ^ Result SQL expression string.+  -- | Unsafely generate SQL expression term from projection object.+  unsafeShowSql' :: p a       -- ^ Source projection object+                 -> StringSQL -- ^ Result SQL expression string. --- | Unsafely get SQL term from 'Expr'.-unsafeShowSqlExpr :: Expr p t -> String-unsafeShowSqlExpr =  UnsafeExpr.showExpr+-- | Unsafely generate SQL expression string from projection object.+--   String interface of 'unsafeShowSql''.+unsafeShowSql :: ProjectableShowSql p+              => p a    -- ^ Source projection object+              -> String -- ^ Result SQL expression string.+unsafeShowSql =  showStringSQL . unsafeShowSql'  -- | Unsafely get SQL term from 'Expr'. instance ProjectableShowSql (Expr p) where-  unsafeShowSql = unsafeShowSqlExpr+  unsafeShowSql' = UnsafeExpr.unsafeStringSql  -- | Unsafely get SQL term from 'Proejction'. instance ProjectableShowSql (Projection c) where-  unsafeShowSql = unsafeShowSqlProjection+  unsafeShowSql' = Projection.unsafeStringSql   -- | Binary operator type for SQL String.@@ -196,15 +194,12 @@                => Keyword -> p a -> p b unsafeFlatUniOp kw = unsafeUniOp (SQL.paren . SQL.defineUniOp kw) -parenBinStr :: SqlBinOp -> String -> String -> String-parenBinStr op = SQL.strBinOp $ \x y -> SQL.paren $ op x y- -- | Unsafely make projection binary operator from string binary operator. unsafeBinOp :: (SqlProjectable p, ProjectableShowSql p)             => SqlBinOp             -> p a -> p b -> p c-unsafeBinOp op a b = unsafeProjectSql-                     $ parenBinStr op (unsafeShowSql a) (unsafeShowSql b)+unsafeBinOp op a b = unsafeProjectSql' . SQL.paren $+                     op (unsafeShowSql' a) (unsafeShowSql' b)  -- | Unsafely make compare projection binary operator from string binary operator. compareBinOp :: (SqlProjectable p, ProjectableShowSql p)@@ -267,8 +262,8 @@ -- | Logical operator corresponding SQL /EXISTS/ . exists :: (SqlProjectable p, ProjectableShowSql p)        => ListProjection (Projection Exists) r -> p (Maybe Bool)-exists =  unsafeProjectSql . SQL.strUniOp (SQL.paren . SQL.defineUniOp SQL.EXISTS)-          . unsafeShowSqlListProjection unsafeShowSql+exists =  unsafeProjectSql' . SQL.paren . SQL.defineUniOp SQL.EXISTS+          . Projection.unsafeStringSqlList unsafeShowSql'  -- | Concatinate operator corresponding SQL /||/ . (.||.) :: (SqlProjectable p, ProjectableShowSql p, IsString a)@@ -312,7 +307,7 @@  unsafeCastProjectable :: (SqlProjectable p, ProjectableShowSql p)                            => p a -> p b-unsafeCastProjectable = unsafeProjectSql . unsafeShowSql+unsafeCastProjectable = unsafeProjectSql' . unsafeShowSql'  -- | Number fromIntegral uni-operator. fromIntegral' :: (SqlProjectable p, ProjectableShowSql p, Integral a, Num b)@@ -359,9 +354,6 @@                    => p (Maybe a) -> p (Maybe b) showNumMaybe = unsafeCastProjectable -unsafeSqlWord :: ProjectableShowSql p => p a -> Keyword-unsafeSqlWord =  SQL.word . unsafeShowSql- whensClause :: (SqlProjectable p, ProjectableShowSql p)             => String       -- ^ Error tag             -> [(p a, p b)] -- ^ Each when clauses@@ -370,8 +362,8 @@ 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 <> unsafeSqlWord p <> SQL.THEN <> unsafeSqlWord r-  else'     = SQL.ELSE <> unsafeSqlWord e+  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/@@ -379,7 +371,7 @@            => [(p (Maybe Bool), p a)] -- ^ Each when clauses            -> p a                     -- ^ Else result projection            -> p a                     -- ^ Result projection-caseSearch cs e = unsafeProjectSql . SQL.wordShow $ SQL.CASE <> whensClause "caseSearch" cs e+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)@@ -401,7 +393,7 @@       -> [(p a, p b)] -- ^ Each when clauses       -> p b          -- ^ Else result projection       -> p b          -- ^ Result projection-case' v cs e = unsafeProjectSql . SQL.wordShow $ SQL.CASE <> unsafeSqlWord v <> whensClause "case'" cs e+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)@@ -420,15 +412,15 @@ -- | Binary operator corresponding SQL /IN/ . in' :: (SqlProjectable p, ProjectableShowSql p)     => p t -> ListProjection p t -> p (Maybe Bool)-in' a lp = unsafeProjectSql-           $ parenBinStr SQL.in' (unsafeShowSql a) (unsafeShowSqlListProjection unsafeShowSql lp)+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)           => Projection c (Maybe r) -> Projection c (Maybe Bool)-isNothing mr = unsafeProjectSql $-               parenBinStr (SQL.defineBinOp SQL.IS)-               (Projection.unsafeShowSqlNotNullMaybeProjection mr) (SQL.wordShow SQL.NULL)+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)@@ -447,7 +439,7 @@ {-# DEPRECATED fromMaybe' "Use fromMaybe instead of this." #-}  unsafeUniTermFunction :: SqlProjectable p => Keyword -> p t-unsafeUniTermFunction =  unsafeProjectSql . (++ "()") . SQL.wordShow+unsafeUniTermFunction =  unsafeProjectSql' . (SQL.<++> stringSQL "()")  -- | /RANK()/ term. rank :: Projection OverWindow Int64@@ -510,7 +502,7 @@  unsafeProjectPlaceHolder' :: (PersistableWidth r, SqlProjectable p)                                => (PersistableRecordWidth r, p r)-unsafeProjectPlaceHolder' =  unsafeProjectSqlTerms . (`replicate` "?") <$> derivedWidth+unsafeProjectPlaceHolder' =  unsafeProjectSqlTerms' . (`replicate` "?") <$> derivedWidth  unsafeProjectPlaceHolder :: (PersistableWidth r, SqlProjectable p)                                => p r
src/Database/Relational/Query/Projection.hs view
@@ -18,25 +18,27 @@   columns,   untype, -  unsafeFromColumns,+  unsafeFromSqlTerms,   unsafeFromQualifiedSubQuery,   unsafeFromScalarSubQuery,   unsafeFromTable,   predicateProjectionFromExpr, +  unsafeStringSql,+   -- * Projections   pi, piMaybe, piMaybe',    flattenMaybe, just,    unsafeToAggregated, unsafeToFlat, unsafeChangeContext,-  unsafeShowSqlNotNullMaybeProjection,+  unsafeStringSqlNotNullMaybe,    pfmap, pap,    -- * List Projection-  ListProjection, list, unsafeListProjectionFromSubQuery,-  unsafeShowSqlListProjection+  ListProjection, list, unsafeListFromSubQuery,+  unsafeStringSqlList   ) where  import Prelude hiding (pi)@@ -46,13 +48,14 @@ import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint) import qualified Database.Record.KeyConstraint as KeyConstraint -import Database.Relational.Query.Internal.SQL (rowListStringString)+import Database.Relational.Query.Internal.SQL (StringSQL, rowStringSQL, rowListStringSQL) import Database.Relational.Query.Context (Aggregated, Flat)-import Database.Relational.Query.Component (ColumnSQL, columnSQL')+import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, columnSQL') import Database.Relational.Query.Table (Table) import qualified Database.Relational.Query.Table as Table import Database.Relational.Query.Pure (ProductConstructor (..))-import Database.Relational.Query.Expr.Unsafe (Expr, sqlExpr)+import Database.Relational.Query.Expr.Unsafe (Expr)+import qualified Database.Relational.Query.Expr.Unsafe as UnsafeExpr import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi import Database.Relational.Query.Sub@@ -103,9 +106,17 @@ -- | Lift 'Expr' to 'Projection' to use as restrict predicate. predicateProjectionFromExpr :: Expr c (Maybe Bool) -> Projection c (Maybe Bool) predicateProjectionFromExpr =-  typedProjection . untypedProjectionFromColumns . (:[]) .  columnSQL' . sqlExpr+  typedProjection . untypedProjectionFromColumns . (:[]) .  columnSQL' . UnsafeExpr.unsafeStringSql +-- | Unsafely get SQL term from 'Proejction'.+unsafeStringSql :: Projection c r -> StringSQL+unsafeStringSql =  rowStringSQL . map showsColumnSQL . columns +-- | Unsafely generate 'Projection' from SQL expression strings.+unsafeFromSqlTerms :: [StringSQL] -> Projection c t+unsafeFromSqlTerms =  unsafeFromColumns . map columnSQL'++ -- | Unsafely trace projection path. unsafeProject :: Projection c a' -> Pi a b -> Projection c b' unsafeProject p pi' =@@ -159,8 +170,8 @@ notNullMaybeConstraint =  const KeyConstraint.columnConstraint  -- | Unsafely get SQL string expression of not null key projection.-unsafeShowSqlNotNullMaybeProjection :: HasColumnConstraint NotNull r => Projection c (Maybe r) -> String-unsafeShowSqlNotNullMaybeProjection p = show . (!!  KeyConstraint.index (notNullMaybeConstraint p)) . columns $ p+unsafeStringSqlNotNullMaybe :: HasColumnConstraint NotNull r => Projection c (Maybe r) -> StringSQL+unsafeStringSqlNotNullMaybe p = showsColumnSQL . (!!  KeyConstraint.index (notNullMaybeConstraint p)) . columns $ p  -- | Projectable fmap of 'Projection' type. pfmap :: ProductConstructor (a -> b)@@ -180,11 +191,11 @@ list =  List  -- | Make row list projection from 'SubQuery'.-unsafeListProjectionFromSubQuery :: SubQuery -> ListProjection p t-unsafeListProjectionFromSubQuery =  Sub+unsafeListFromSubQuery :: SubQuery -> ListProjection p t+unsafeListFromSubQuery =  Sub  -- | Map projection show operatoions and concatinate to single SQL expression.-unsafeShowSqlListProjection :: (p t -> String) -> ListProjection p t -> String-unsafeShowSqlListProjection sf = d  where-  d (List ps) = rowListStringString $ map sf ps-  d (Sub sub) = SQL.wordShow . SQL.paren $ SubQuery.showSQL sub+unsafeStringSqlList :: (p t -> StringSQL) -> ListProjection p t -> StringSQL+unsafeStringSqlList sf = d  where+  d (List ps) = rowListStringSQL $ map sf ps+  d (Sub sub) = SQL.paren $ SubQuery.showSQL sub
src/Database/Relational/Query/Pure.hs view
@@ -17,7 +17,7 @@   ProductConstructor (..),    -- * Constant SQL Terms-  ShowConstantTermsSQL (..)+  ShowConstantTermsSQL (..), showConstantTermsSQL   ) where  import Data.Monoid (mconcat)@@ -32,11 +32,12 @@ import Data.Time (FormatTime, Day, TimeOfDay, LocalTime, formatTime) import Data.Time.Locale.Compat (defaultTimeLocale) -import Language.SQL.Keyword (Keyword (..), wordShow)+import Language.SQL.Keyword (Keyword (..)) import Database.Record   (PersistableWidth, persistableWidth, PersistableRecordWidth) import Database.Record.Persistable   (runPersistableRecordWidth)+import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL)   -- | Specify tuple like record constructors which are allowed to define 'ProjectableFunctor'.@@ -50,10 +51,10 @@   -- | Constant integral SQL expression.-intExprSQL :: (Show a, Integral a) => a -> String-intExprSQL =  show+intExprSQL :: (Show a, Integral a) => a -> StringSQL+intExprSQL =  stringSQL . show -intTermsSQL :: (Show a, Integral a) => a -> [String]+intTermsSQL :: (Show a, Integral a) => a -> [StringSQL] intTermsSQL =  (:[]) . intExprSQL  -- | Escape 'String' for constant SQL string expression.@@ -64,99 +65,103 @@   rec (c:cs)    = c : rec cs  -- | From 'String' into constant SQL string expression.-stringExprSQL :: String -> String-stringExprSQL =  ('\'':) . (++ "'") . escapeStringToSqlExpr+stringExprSQL :: String -> StringSQL+stringExprSQL =  stringSQL . ('\'':) . (++ "'") . escapeStringToSqlExpr -stringTermsSQL :: String -> [String]+stringTermsSQL :: String -> [StringSQL] stringTermsSQL =  (:[]) . stringExprSQL  -- | Interface for constant SQL term list. class ShowConstantTermsSQL a where-  showConstantTermsSQL :: a -> [String]+  showConstantTermsSQL' :: a -> [StringSQL] +-- | String interface of 'showConstantTermsSQL''.+showConstantTermsSQL :: ShowConstantTermsSQL a => a -> [String]+showConstantTermsSQL =  map showStringSQL . showConstantTermsSQL'+ -- | Constant SQL terms of 'Int16'. instance ShowConstantTermsSQL Int16 where-  showConstantTermsSQL = intTermsSQL+  showConstantTermsSQL' = intTermsSQL  -- | Constant SQL terms of 'Int32'. instance ShowConstantTermsSQL Int32 where-  showConstantTermsSQL = intTermsSQL+  showConstantTermsSQL' = intTermsSQL  -- | Constant SQL terms of 'Int64'. instance ShowConstantTermsSQL Int64 where-  showConstantTermsSQL = intTermsSQL+  showConstantTermsSQL' = intTermsSQL  -- | Constant SQL terms of 'String'. instance ShowConstantTermsSQL String where-  showConstantTermsSQL = stringTermsSQL+  showConstantTermsSQL' = stringTermsSQL  -- | Constant SQL terms of 'ByteString'. instance ShowConstantTermsSQL ByteString where-  showConstantTermsSQL = stringTermsSQL . T.unpack . T.decodeUtf8+  showConstantTermsSQL' = stringTermsSQL . T.unpack . T.decodeUtf8  -- | Constant SQL terms of 'LB.ByteString'. instance ShowConstantTermsSQL LB.ByteString where-  showConstantTermsSQL = showConstantTermsSQL . mconcat . LB.toChunks+  showConstantTermsSQL' = mconcat . map showConstantTermsSQL' . LB.toChunks  -- | Constant SQL terms of 'Text'. instance ShowConstantTermsSQL Text where-  showConstantTermsSQL = stringTermsSQL . T.unpack+  showConstantTermsSQL' = stringTermsSQL . T.unpack  -- | Constant SQL terms of 'LT.Text'. instance ShowConstantTermsSQL LT.Text where-  showConstantTermsSQL = showConstantTermsSQL . LT.toStrict+  showConstantTermsSQL' = mconcat . map showConstantTermsSQL' . LT.toChunks  -- | Constant SQL terms of 'Char'. instance ShowConstantTermsSQL Char where-  showConstantTermsSQL = stringTermsSQL . (:"")+  showConstantTermsSQL' = stringTermsSQL . (:"")  -- | Constant SQL terms of 'Bool'. instance ShowConstantTermsSQL Bool where-  showConstantTermsSQL = (:[]) . d  where+  showConstantTermsSQL' = (:[]) . stringSQL . d  where     d True  = "(0=0)"     d False = "(0=1)" -floatTerms :: (PrintfArg a, Ord a, Num a)=> a -> [String]-floatTerms f = (:[]) $ printf fmt f  where+floatTerms :: (PrintfArg a, Ord a, Num a)=> a -> [StringSQL]+floatTerms f = (:[]) . stringSQL $ printf fmt f  where   fmt     | f >= 0    = "%f"     | otherwise = "(%f)"  -- | Constant SQL terms of 'Float'. Caution for floating-point error rate. instance ShowConstantTermsSQL Float where-  showConstantTermsSQL = floatTerms+  showConstantTermsSQL' = floatTerms  -- | Constant SQL terms of 'Double'. Caution for floating-point error rate. instance ShowConstantTermsSQL Double where-  showConstantTermsSQL = floatTerms+  showConstantTermsSQL' = floatTerms -constantTimeTerms :: FormatTime t => Keyword -> String -> t -> [String]-constantTimeTerms kw fmt t = [unwords [wordShow kw,+constantTimeTerms :: FormatTime t => Keyword -> String -> t -> [StringSQL]+constantTimeTerms kw fmt t = [mconcat [kw,                                        stringExprSQL $ formatTime defaultTimeLocale fmt t]]  -- | Constant SQL terms of 'Day'. instance ShowConstantTermsSQL Day where-  showConstantTermsSQL = constantTimeTerms DATE "%Y-%m-%d"+  showConstantTermsSQL' = constantTimeTerms DATE "%Y-%m-%d"  -- | Constant SQL terms of 'TimeOfDay'. instance ShowConstantTermsSQL TimeOfDay where-  showConstantTermsSQL = constantTimeTerms TIME "%H:%M:%S"+  showConstantTermsSQL' = constantTimeTerms TIME "%H:%M:%S"  -- | Constant SQL terms of 'LocalTime'. instance ShowConstantTermsSQL LocalTime where-  showConstantTermsSQL = constantTimeTerms TIMESTAMP "%Y-%m-%d %H:%M:%S"+  showConstantTermsSQL' = constantTimeTerms TIMESTAMP "%Y-%m-%d %H:%M:%S" -showMaybeTerms :: ShowConstantTermsSQL a => PersistableRecordWidth a -> Maybe a -> [String]+showMaybeTerms :: ShowConstantTermsSQL a => PersistableRecordWidth a -> Maybe a -> [StringSQL] showMaybeTerms wa = d  where-  d (Just a) = showConstantTermsSQL a-  d Nothing  = replicate (runPersistableRecordWidth wa) "NULL"+  d (Just a) = showConstantTermsSQL' a+  d Nothing  = replicate (runPersistableRecordWidth wa) $ stringSQL "NULL"  -- | Constant SQL terms of 'Maybe' type. Width inference is required. instance (PersistableWidth a, ShowConstantTermsSQL a)          => ShowConstantTermsSQL (Maybe a) where-  showConstantTermsSQL = showMaybeTerms persistableWidth+  showConstantTermsSQL' = showMaybeTerms persistableWidth  -- | Constant SQL terms of '(a, b)' type. instance (ShowConstantTermsSQL a, ShowConstantTermsSQL b)          => ShowConstantTermsSQL (a, b) where-  showConstantTermsSQL (a, b) = showConstantTermsSQL a ++ showConstantTermsSQL b+  showConstantTermsSQL' (a, b) = showConstantTermsSQL' a ++ showConstantTermsSQL' b
src/Database/Relational/Query/Relation.hs view
@@ -70,7 +70,7 @@ import Database.Relational.Query.Scalar (ScalarDegree) import Database.Relational.Query.Pi (Pi) import Database.Relational.Query.Projection-  (Projection, ListProjection, unsafeListProjectionFromSubQuery)+  (Projection, ListProjection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Projectable   (PlaceHolders, unitPlaceHolder, unsafeAddPlaceHolders, unsafePlaceHolders, projectZip)@@ -146,7 +146,7 @@  queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (ListProjection (Projection c) r) queryList0 =  liftQualify-              . fmap unsafeListProjectionFromSubQuery+              . fmap Projection.unsafeListFromSubQuery               . subQueryQualifyFromRelation  -- | List subQuery, for /IN/ and /EXIST/ with place-holder parameter 'p'.
src/Database/Relational/Query/Sub.hs view
@@ -42,7 +42,7 @@  import qualified Database.Relational.Query.Context as Context import Database.Relational.Query.Expr (valueExpr)-import Database.Relational.Query.Expr.Unsafe (sqlExpr)+import Database.Relational.Query.Expr.Unsafe (unsafeStringSql) import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL) import Database.Relational.Query.Internal.Product   (NodeAttr(Just', Maybe), ProductTree (Leaf, Join),@@ -358,7 +358,7 @@      joinType (nodeAttr left') (nodeAttr right'), JOIN,      urec right',      ON,-     sqlExpr . fromMaybe (valueExpr True) {- or error on compile -}  $ rs]+     unsafeStringSql . fromMaybe (valueExpr True) {- or error on compile -}  $ rs]  -- | Type for join product of query. type JoinProduct = Maybe QueryProduct
src/Database/Relational/Query/TH.hs view
@@ -80,7 +80,7 @@ import qualified Database.Record.TH as Record  import Database.Relational.Query-  (Table, Pi, Relation, Config (normalizedTableName), ProductConstructor (..),+  (Table, Pi, id', Relation, Config (normalizedTableName), ProductConstructor (..),    relationalQuerySQL, Query, relationalQuery, KeyUpdate,    Insert, derivedInsert, InsertQuery, derivedInsertQuery,    HasConstraintKey(constraintKey), Primary, NotNull, primary, primaryUpdate)@@ -210,10 +210,10 @@              [| derivedRelation |]   let insVar   = varName insVar'   insDs   <- simpleValD insVar   [t| Insert $recordType |]-             [| derivedInsert |]+             [| derivedInsert id' |]   let insQVar  = varName insQVar'   insQDs  <- simpleValD insQVar  [t| forall p . Relation p $recordType -> InsertQuery p |]-             [| derivedInsertQuery |]+             [| derivedInsertQuery id' |]   return $ concat [tableDs, relDs, insDs, insQDs]  -- | 'Table' and 'Relation' templates.
src/Database/Relational/Query/Type.hs view
@@ -25,7 +25,7 @@    -- * Typed insert statement   Insert (..), unsafeTypedInsert', unsafeTypedInsert, typedInsert', typedInsert, derivedInsert,-  InsertQuery (..), unsafeTypedInsertQuery, typedInsertQuery, derivedInsertQuery,+  InsertQuery (..), unsafeTypedInsertQuery, typedInsertQuery', typedInsertQuery, derivedInsertQuery,    insertQuerySQL, @@ -49,7 +49,6 @@    UpdateTarget, UpdateTargetContext, updateTarget', liftTargetAllColumn',    sqlWhereFromRestriction, sqlFromUpdateTarget) import Database.Relational.Query.Pi (Pi)-import qualified Database.Relational.Query.Pi as Pi import Database.Relational.Query.Component (Config (chunksInsertSize), defaultConfig) import Database.Relational.Query.Table (Table, TableDerivable, derivedTable) import Database.Relational.Query.SQL@@ -192,9 +191,9 @@ typedInsert :: Table r -> Pi r r' -> Insert r' typedInsert =  typedInsert' defaultConfig --- | Infered 'Insert'.-derivedInsert :: TableDerivable r => Insert r-derivedInsert =  typedInsert derivedTable Pi.id'+-- | Table type infered 'Insert'.+derivedInsert :: TableDerivable r => Pi r r' -> Insert r'+derivedInsert =  typedInsert derivedTable  -- | Show insert SQL string. instance Show (Insert a) where@@ -207,17 +206,21 @@ unsafeTypedInsertQuery :: String -> InsertQuery p unsafeTypedInsertQuery =  InsertQuery --- | Make untyped insert select SQL string from 'Table' and 'Relation'.-insertQuerySQL :: TableDerivable r => Config -> Pi r r' -> Relation p r' -> String-insertQuerySQL config pi' rel = showStringSQL $ insertPrefixSQL pi' derivedTable <> sqlFromRelationWith rel config+-- | Make untyped insert select SQL string from 'Table', 'Pi' and 'Relation'.+insertQuerySQL :: Config -> Table r -> Pi r r' -> Relation p r' -> String+insertQuerySQL config tbl pi' rel = showStringSQL $ insertPrefixSQL pi' tbl <> sqlFromRelationWith rel config --- | Make typed 'InsertQuery' from columns selector 'Pi' and 'Table' and 'Relation'.-typedInsertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p-typedInsertQuery pi' rel = unsafeTypedInsertQuery $ insertQuerySQL defaultConfig pi' rel+-- | Make typed 'InsertQuery' from columns selector 'Table', 'Pi' and 'Relation' with configuration parameter.+typedInsertQuery' :: Config -> Table r -> Pi r r' -> Relation p r' -> InsertQuery p+typedInsertQuery' config tbl pi' rel = unsafeTypedInsertQuery $ insertQuerySQL config tbl pi' rel --- | Infered 'InsertQuery'.-derivedInsertQuery :: TableDerivable r => Relation p r -> InsertQuery p-derivedInsertQuery =  typedInsertQuery Pi.id'+-- | Make typed 'InsertQuery' from columns selector 'Table', 'Pi' and 'Relation'.+typedInsertQuery :: Table r -> Pi r r' -> Relation p r' -> InsertQuery p+typedInsertQuery =  typedInsertQuery' defaultConfig++-- | Table type infered 'InsertQuery'.+derivedInsertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p+derivedInsertQuery =  typedInsertQuery derivedTable  -- | Show insert SQL string. instance Show (InsertQuery p) where
test/SQLs.hs view
@@ -143,7 +143,7 @@         ]  insertX :: Insert SetA-insertX =  derivedInsert+insertX =  derivedInsert id'  updateKeyX :: KeyUpdate Int32 SetA updateKeyX =  primaryUpdate tableOfSetA