persistent-qq 2.9.0 → 2.9.1

raw patch · 3 files changed

+33/−10 lines, 3 filesdep +semigroupsnew-uploader

Dependencies added: semigroups

Files

• ChangeLog.md +4/−0
• persistent-qq.cabal +7/−4
• src/Database/Persist/Sql/Raw/QQ.hs +22/−6

@@ -1,5 +1,9 @@ # Changelog for persistent-qq +## 2.9.1++* Added support for list of values in `sqlQQ`. [#819](https://github.com/yesodweb/persistent/pull/819)+ ## 2.9.0  * Initial release, code separated from `persistent`

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.30.0.+-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 01105cd47a96bd60bf3b8a6912b056d68f7fb516660a271c0031a24c9a420302+-- hash: 9d1539e33f41bc20d3eaf4418ed42bdffc6936808b93c84ae04445144ef549a8  name:           persistent-qq-version:        2.9.0+version:        2.9.1 synopsis:       Provides a quasi-quoter for raw SQL for persistent description:    Please see README and API docs at <http://www.stackage.org/package/persistent>. category:       Database, Yesod@@ -38,7 +38,10 @@       base >=4.7 && <5     , haskell-src-meta     , mtl-    , persistent >=2.9.1+    , persistent >=2.9     , template-haskell     , text+  if impl(ghc < 8)+    build-depends:+        semigroups   default-language: Haskell2010

@@ -32,7 +32,8 @@ import Prelude import Control.Arrow (first, second) import Control.Monad.Reader (ask)-import Data.Text (pack, unpack)+import qualified Data.List.NonEmpty (toList)+import Data.Text (pack, unpack, intercalate) import Data.Maybe (fromMaybe, Maybe(..)) import Data.Monoid (mempty, (<>)) import qualified Language.Haskell.TH as TH@@ -46,6 +47,7 @@ data Token   = Literal String   | Value String+  | Values String   | TableName String   | ColumnName String   deriving Show@@ -64,6 +66,7 @@ parseStr a ('\\':x:xs)  = parseStr (x:a) xs parseStr a ['\\']       = parseStr ('\\':a) [] parseStr a ('#':'{':xs) = Literal (reverse a) : parseHaskell Value      [] xs+parseStr a ('%':'{':xs) = Literal (reverse a) : parseHaskell Values     [] xs parseStr a ('^':'{':xs) = Literal (reverse a) : parseHaskell TableName  [] xs parseStr a ('@':'{':xs) = Literal (reverse a) : parseHaskell ColumnName [] xs parseStr a (x:xs)       = parseStr (x:a) xs@@ -71,21 +74,29 @@ makeExpr :: TH.ExpQ -> [Token] -> TH.ExpQ makeExpr fun toks = do     TH.infixE-        (Just [| uncurry $(fun) |])+        (Just [| uncurry $(fun) . second concat |])         ([| (=<<) |])         (Just $ go toks)      where     go :: [Token] -> TH.ExpQ-    go [] = [| return (mempty, mempty) |]+    go [] = [| return (mempty, []) |]     go (Literal a:xs) =         TH.appE             [| fmap $ first (pack a <>) |]             (go xs)     go (Value a:xs) =         TH.appE-            [| fmap $ first ("?" <>) . second (toPersistValue $(reifyExp a) :) |]+            [| fmap $ first ("?" <>) . second ([toPersistValue $(reifyExp a)] :) |]             (go xs)+    go (Values a:xs) =+        TH.appE+            [| let a' = Data.List.NonEmpty.toList $(reifyExp a) in+               fmap $+                 first (("(" <> intercalate ", " (replicate (length a') "?") <> ")") <>) .+                 second (map toPersistValue a' :)+             |]+            (go xs)     go (ColumnName a:xs) = do         colN <- TH.newName "field"         TH.infixE@@ -147,6 +158,7 @@ -- Category --   rgt Int --   lft Int+--   nam Text -- @ -- -- We can now execute this raw query:@@ -155,18 +167,22 @@ -- let lft = 10 :: Int --     rgt = 20 :: Int --     width = rgt - lft+--     nams = "first" :| ["second", "third"] --  in [sqlQQ| --       DELETE FROM ^{Category} WHERE @{CategoryLft} BETWEEN #{lft} AND #{rgt}; --       UPDATE category SET @{CategoryRgt} = @{CategoryRgt} - #{width} WHERE @{CategoryRgt} > #{rgt}; --       UPDATE category SET @{CategoryLft} = @{CategoryLft} - #{width} WHERE @{CategoryLft} > #{rgt};+--       SELECT ?? FROM ^{Category} WHERE ^{Category}.@{CategoryNam} IN %{nams}; --     |] -- @ -- -- @^{TableName}@ looks up the table's name and escapes it, @\@{ColumnName}@--- looks up the column's name and properly escapes it and @#{value}@ inserts--- the value via the usual parameter substitution mechanism.+-- looks up the column's name and properly escapes it, @#{value}@ inserts+-- the value via the usual parameter substitution mechanism and @%{values}@+-- inserts comma separated values (of a 'Data.List.NonEmpty.NonEmpty' list). -- -- @since 2.9.0+-- @%{values}@ was added with 2.9.1 sqlQQ :: QuasiQuoter sqlQQ = makeQQ [| rawSql |]