packages feed

sqlite-simple-interpolate 0.1.1 → 0.2.0.0

raw patch · 9 files changed

+205/−284 lines, 9 filesdep +custom-interpolationdep −haskell-src-metadep −mtldep −parsecdep ~basedep ~template-haskellsetup-changed

Dependencies added: custom-interpolation

Dependencies removed: haskell-src-meta, mtl, parsec

Dependency ranges changed: base, template-haskell

Files

CHANGELOG.md view
@@ -1,10 +1,17 @@ # Changelog +## 0.2.0.0++- **BREAKING**: field interpolation now uses `{}`, _without_ a dollar sign (before: `${}`)+- Rename the module to `Database.SQLite.Simple.Interpolate` (before: `Database.SQLite.Simple.QQ.Interpolated`)+- Add support for row interpolation (uses `@{}` syntax, see the updated readme for details)+- Refactor the parser into a [custom-interpolation](https://hackage.haskell.org/package/custom-interpolation) package which does most of the work+ ## 0.1.1 -* Add support for textual SQL injection (PR #1)-* Support GHC 8.10.7+- Add support for textual SQL injection (PR #1)+- Support GHC 8.10.7  ## 0.1.0 -* Initial version.+- Initial version.
LICENSE view
@@ -1,31 +1,28 @@-Copyright (c) 2019, Elliot Cameron-Copyright (c) 2022, ruby0b+BSD 3-Clause License -All rights reserved.+Copyright (c) 2023, ruby0b  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer. -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution. -    * Neither the name of Taylor Hedberg nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,7 +1,20 @@-# `sqlite-simple-interpolate`+<h1 align="center">sqlite-simple-interpolate</h1> +<p align="center">+  <a href="https://hackage.haskell.org/package/sqlite-simple-interpolate"><img src="https://img.shields.io/hackage/v/sqlite-simple-interpolate" alt="Hackage"></a>+  <a href="https://github.com/ruby0b/sqlite-simple-interpolate/actions/workflows/haskell-ci.yml"><img src="https://github.com/ruby0b/sqlite-simple-interpolate/actions/workflows/haskell-ci.yml/badge.svg" alt="Build Status"></a>+  <a href="https://github.com/simmsb/calamity/blob/master/LICENSE"><img src="https://img.shields.io/github/license/ruby0b/sqlite-simple-interpolate" alt="License"></a>+  <a href="https://hackage.haskell.org/package/sqlite-simple-interpolate"><img src="https://img.shields.io/hackage-deps/v/sqlite-simple-interpolate" alt="Hackage-Deps"></a>+</p>+ Write natural SQL statements in Haskell using QuasiQuoters! +The QuasiQuoters support 3 methods of interpolation that can be mixed freely:++- `{}`: injection-safe field interpolation, e.g. `{myName}` gets replaced with `?` which gets substituted with `toField myName`.+- `@{}`: injection-safe row interpolation, e.g. `@{myPerson}` gets replaced with `(?,?)` (assuming `Person` has two fields) which gets substituted with `toRow myPerson`.+- `!{}`: injection-_vulnerable_ raw string interpolation. **Never use this for user input!** Intended for use cases that the anti-injection mechanisms won't allow, e.g. table names: `!{myTableName}` gets replaced with the value of `myTableName :: String`.+ ```haskell {-# LANGUAGE QuasiQuotes #-} @@ -11,28 +24,38 @@ import Data.Char (toLower) import Data.Function ((&)) import qualified Database.SQLite.Simple as SQL-import Database.SQLite.Simple.QQ.Interpolated+import Database.SQLite.Simple.Interpolate +data Person = Person {name :: String, age :: Integer}++instance SQL.ToRow Person where+  toRow p = SQL.toRow (name p, age p)+ table :: String table = "people"  main :: IO () main = bracket (SQL.open ":memory:") SQL.close $ \conn -> do+  -- Create a table, interpolating safe string constants like table names with !{}   conn & [iexecute|CREATE TABLE !{table} (name TEXT, age INTEGER)|] -  conn & [iexecute|INSERT INTO !{table} VALUES ("clive", 40)|]-  -- you can always use 'isql' directly but you'll have to use uncurry:-  (uncurry $ SQL.execute conn) [isql|INSERT INTO !{table} VALUES ("clara", 32)|]+  -- Insert a person, safely interpolating a field using {}+  let name = "clive"+  conn & [iexecute|INSERT INTO !{table} VALUES ({name}, 40)|] -  ageSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))-  print (ageSum :: Int)+  -- Insert a person, safely interpolating an entire row type using @{} (gets replaced with "(?,?)")+  let clara = Person {name = "clara", age = 25}+  conn & [iexecute|INSERT INTO !{table} VALUES @{clara}|] -  let limit = 1 :: Int-  ages <- conn & [iquery|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]-  print (ages :: [SQL.Only Int])-```+  -- Use ifold to fold some rows into their sum in haskell+  ageHaskellSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))+  print (ageHaskellSum :: Int) -## Acknowledgements-This library is a fork of [`postgresql-simple-interpolate`](https://github.com/3noch/postgresql-simple-interpolate), adapted for use with `sqlite-simple`.+  -- Let's calculate the average age of people that are at least 20 years old+  let minAge = 20 :: Int+  [ageAvg] <- conn & [iquery|SELECT AVG(age) FROM !{table} WHERE age >= {minAge}|]+  print (ageAvg :: SQL.Only Double) -The original itself is basically just a copy of the [`here` package](https://github.com/tmhedberg/here) by Taylor M. Hedberg with slight modifications!+  -- You can always use 'isql' directly but you'll have to use uncurry:+  (uncurry $ SQL.execute conn) [isql|INSERT OR REPLACE INTO !{table} VALUES ({name}, 41)|]+```
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
sqlite-simple-interpolate.cabal view
@@ -1,20 +1,17 @@ cabal-version:      3.0 name:               sqlite-simple-interpolate-version:            0.1.1+version:            0.2.0.0 synopsis:           Interpolated SQLite queries via quasiquotation description:-  This package provides Quasiquoters for writing SQLite queries with inline interpolation of values.-  The values are interpolated using toField from sqlite-simple.-  See the README for more details.+  Please see the readme at https://github.com/ruby0b/sqlite-simple-interpolate#readme.  license:            BSD-3-Clause license-file:       LICENSE author:             ruby0b maintainer:         ruby0b-copyright:          ©2022 ruby0b ©2019 Elliot Cameron homepage:           https://github.com/ruby0b/sqlite-simple-interpolate category:           Database-tested-with:        GHC ==8.10.7 || ==9.0.2+tested-with:        GHC ==8.10.7 || ==9.2.5 || ==9.4.4 extra-source-files:   CHANGELOG.md   README.md@@ -26,20 +23,21 @@   location: git://github.com/ruby0b/sqlite-simple-interpolate.git  library-  hs-source-dirs:   src-  exposed-modules:  Database.SQLite.Simple.QQ.Interpolated-  other-modules:    Database.SQLite.Simple.QQ.Interpolated.Parser+  hs-source-dirs:     src+  exposed-modules:    Database.SQLite.Simple.Interpolate   build-depends:-    , base              >=4.5  && <5-    , haskell-src-meta  >=0.6  && <0.9-    , mtl               >=2.1  && <2.3-    , parsec            ^>=3.1-    , sqlite-simple     >=0.1-    , template-haskell  >=2.16 && <2.19+    , base                  >=4.14 && <5+    , custom-interpolation  ^>=0.1+    , sqlite-simple         >=0.1+    , template-haskell      >=2.16 && <2.20 -  ghc-options:      -Wall-  default-language: Haskell2010+  default-extensions:+    TemplateHaskell+    QuasiQuotes +  ghc-options:        -Wall+  default-language:   Haskell2010+ flag tests   manual:  False   default: True@@ -49,7 +47,7 @@   main-is:          Main.hs   hs-source-dirs:   tests   build-depends:-    , base                       >=4.7 && <5+    , base     , sqlite-simple     , sqlite-simple-interpolate
+ src/Database/SQLite/Simple/Interpolate.hs view
@@ -0,0 +1,104 @@+-- | Interpolated SQLite queries+module Database.SQLite.Simple.Interpolate (+  isql,+  iquery,+  iexecute,+  ifold,+  quoteInterpolatedSql,+) where++import CustomInterpolation+import Data.Maybe (catMaybes)+import Data.String (fromString)+import Database.SQLite.Simple+import Database.SQLite.Simple.ToField (toField)+import GHC.OldList (intercalate)+import Language.Haskell.TH (Exp, Q, appE, listE, sigE, stringE, tupE, varE)+import Language.Haskell.TH.Quote (QuasiQuoter (..))++{- | Quote an SQL statement with embedded antiquoted expressions.++The result of the quasiquoter is a tuple, containing the statement string and a list+of parameters. For example:++>>> import Data.Char (toLower)+>>> [isql|SELECT field FROM !{map toLower "PEOPLE"} WHERE name = {map toLower "ELLIOT"} AND access IN @{["admin", "employee"]} LIMIT {10 :: Int}|]+("SELECT field FROM people WHERE name = ? AND access IN (?,?) LIMIT ?",[SQLText "elliot",SQLText "admin",SQLText "employee",SQLInteger 10])++The generated code is:++@("SELECT field FROM people WHERE name = ? AND access IN (?,?) LIMIT ?", ['toField' (map toLower "ELLIOT")] ++ 'toRow' ["admin", "employee"] ++ ['toField' (10 :: Int)])@++How the parser works:++* Any expression occurring between @{@ and @}@ will be replaced with a @?@+and passed as a query parameter using 'toField'.+* Any expression occuring between @\@{@ and @}@ will be replaced with the right amount of @?@, separated by commas and surrounded by parentheses (e.g. @(?,?,?)@ for a `ToRow` instance with 3 fields).+The expression gets converted to query parameters using 'toRow'.+* Any expression occurring between @!{@ and @}@ will be replaced with its value, bypassing the anti-injection mechanisms. /Never use this one for user input!/++Characters preceded by a backslash are treated literally. This enables the+inclusion of the literal character @{@ within your quoted text by writing+it as @\\{@. The literal sequence @\\{@ may be written as @\\\\{@.+-}+isql :: QuasiQuoter+isql =+  QuasiQuoter+    { quoteExp = quoteInterpolatedSql,+      quotePat = error "This quasiquoter does not support usage in patterns",+      quoteType = error "This quasiquoter does not support usage in types",+      quoteDec = error "This quasiquoter does not support usage in declarations"+    }++-- | The Template Haskell function used by 'isql'.+quoteInterpolatedSql :: String -> Q Exp+quoteInterpolatedSql =+  interpolate+    defaultConfig+      { finalize = consumeInterpolated,+        handlers =+          [ simpleInterpolator+              { prefix = "",+                handler = \sqlFieldExpr -> (Just $ listE [appE (varE 'toField) sqlFieldExpr], [|"?"|])+              },+            simpleInterpolator+              { prefix = "!",+                handler = \stringExpr -> (Nothing, stringExpr)+              },+            simpleInterpolator+              { prefix = "@",+                handler = \sqlRowExpr ->+                  let sqlRow = appE (varE 'toRow) sqlRowExpr+                      rowLength = appE (varE 'length) sqlRow+                      intercalateCommas = appE $ appE (varE 'intercalate) $ stringE ","+                      questionMarks = intercalateCommas $ appE (appE (varE 'replicate) rowLength) [|"?"|]+                      questionMarksWithParens = appE (varE 'concat) $ listE [stringE "(", questionMarks, stringE ")"]+                   in (Just sqlRow, questionMarksWithParens)+              }+          ]+      }++consumeInterpolated :: ([Maybe (Q Exp)], Q Exp) -> Q Exp+consumeInterpolated (sqlDataExprs, queryStrExpr) = tupE [queryStr, sqlData]+  where+    queryStr = appE [|fromString :: String -> Query|] queryStrExpr+    sqlData = sigE (appE (varE 'concat) (listE sqlDataExprs')) [t|[SQLData]|]+    sqlDataExprs' = catMaybes sqlDataExprs++{- | Invokes 'query' with arguments provided by 'isql'.+The result is of type @('Connection' -> 'IO' [r])@.+-}+iquery :: QuasiQuoter+iquery = isql {quoteExp = appE [|\(q, qs) c -> query c q qs|] . quoteInterpolatedSql}++{- | Invokes 'execute' with arguments provided by 'isql'.+The result is of type @('Connection' -> 'IO' ())@.+-}+iexecute :: QuasiQuoter+iexecute = isql {quoteExp = appE [|\(q, qs) c -> execute c q qs|] . quoteInterpolatedSql}++{- | Invokes 'fold' with arguments provided by 'isql'.+The result is of type @(a -> (a -> row -> 'IO' a) -> 'Connection' -> 'IO' a)@.+-}+ifold :: QuasiQuoter+ifold = isql {quoteExp = appE [|\(q, qs) acc f c -> fold c q qs acc f|] . quoteInterpolatedSql}
− src/Database/SQLite/Simple/QQ/Interpolated.hs 
@@ -1,104 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---- | Interpolated SQL queries-module Database.SQLite.Simple.QQ.Interpolated-  ( isql-  , quoteInterpolatedSql-  , iquery-  , iexecute-  , ifold-  ) where--import Language.Haskell.TH (Exp, Q, appE, listE, sigE, tupE, varE, litE)-import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax (Lit(..), lookupValueName)-import Database.SQLite.Simple.ToField (toField)-import Text.Parsec (ParseError)-import Database.SQLite.Simple-import Data.Foldable (foldrM)-import Data.String (fromString)--import Database.SQLite.Simple.QQ.Interpolated.Parser (StringPart (..), parseInterpolated)---- | Quote a SQL statement with embedded antiquoted expressions.------ The result of the quasiquoter is a tuple, containing the statement string and a list--- of parameters. For example:------ @[isql|SELECT field FROM table WHERE name = ${map toLower "ELLIOT"} LIMIT ${10}|]@------ produces------ @("SELECT field FROM table WHERE name = ? LIMIT ?", [toField ((map toLower) "ELLIOT"), toField 10])@------ How the parser works:------ Any expression occurring between @${@ and @}@ will be replaced with a @?@--- and passed as a query parameter.------ Characters preceded by a backslash are treated literally. This enables the--- inclusion of the literal substring @${@ within your quoted text by writing--- it as @\\${@. The literal sequence @\\${@ may be written as @\\\\${@.------ Note: This quasiquoter is a wrapper around 'Database.SQLite.Simple.QQ.sql'.------ This quasiquoter only works in expression contexts and will throw an error--- at compile time if used in any other context.-isql :: QuasiQuoter-isql = QuasiQuoter-  { quoteExp = quoteInterpolatedSql-  , quotePat = error "isql quasiquoter does not support usage in patterns"-  , quoteType = error "isql quasiquoter does not support usage in types"-  , quoteDec = error "isql quasiquoter does not support usage in declarations"-  }--combineParts :: [StringPart] -> Q ([Q Exp], [Q Exp])-combineParts = foldrM step ([], [])-  where-    step subExpr (s, exprs) = case subExpr of-      AntiInject e -> injectExpr e (s, exprs)-      Lit str -> pure (litE (StringL str) : s, exprs)-      Esc c -> pure (litE (StringL [c]) : s, exprs)-      AntiParam e -> pure (litE (StringL "?") : s, e : exprs)--injectExpr :: String -> ([Q Exp], [Q Exp]) -> Q ([Q Exp], [Q Exp])-injectExpr name (s, exprs) = do-  valueName <- lookupValueName name-  case valueName of-    Nothing ->-      fail $ "Value `" ++ name ++ "` is not in scope"-    Just found -> do-      pure (varE found : s, exprs)--applySql :: [StringPart] -> Q Exp-applySql parts = do-  (queryParts, exps) <- combineParts parts-  let queryStr = appE [| fromString :: String -> Query |] $ appE [| concat |] $ listE queryParts-  tupE [queryStr, sigE (listE $ map (appE (varE 'toField)) exps) [t| [SQLData] |]]---- | The internal parser used by 'isql'.-quoteInterpolatedSql :: String -> Q Exp-quoteInterpolatedSql s = either (handleError s) applySql (parseInterpolated s)--handleError :: String -> ParseError -> Q Exp-handleError expStr parseError = error $ mconcat-  [ "Failed to parse interpolated expression in string: "-  , expStr-  , "\n"-  , show parseError-  ]---- | Invokes 'query' with arguments provided by 'isql'.--- The result is of type '(Connection -> IO [r])'.-iquery :: QuasiQuoter-iquery = isql { quoteExp = appE [| \(q, qs) c -> query c q qs |] . quoteInterpolatedSql }---- | Invokes 'execute' with arguments provided by 'isql'--- The result is of type '(Connection -> IO ())'.-iexecute :: QuasiQuoter-iexecute = isql { quoteExp = appE [| \(q, qs) c -> execute c q qs |] . quoteInterpolatedSql }---- | Invokes 'fold' with arguments provided by 'isql'.--- The result is of type 'a -> (a -> row -> IO a) -> Connection -> IO a'.-ifold :: QuasiQuoter-ifold = isql { quoteExp = appE [| \(q, qs) acc f c -> fold c q qs acc f |] . quoteInterpolatedSql }
− src/Database/SQLite/Simple/QQ/Interpolated/Parser.hs 
@@ -1,112 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleContexts #-}---- | Parsers for antiquoted Haskell expressions inside strings.------ This module was largely copied from--- https://github.com/tmhedberg/here/blob/8a616b358bcc16bd215a78a8f6192ad9df8224b6/src/Data/String/Here/Interpolated.hs-module Database.SQLite.Simple.QQ.Interpolated.Parser where--import Data.Char (isDigit, isLetter)-import Data.Functor (($>))-import Control.Monad (unless)-import Control.Monad.State (evalStateT, get, modify)-import Control.Monad.Trans (lift)-import Language.Haskell.Meta (parseExp)-import Language.Haskell.TH (Exp, Q)-import Text.Parsec ( ParseError, anyChar, between, char, eof, incSourceColumn-                   , getInput, lookAhead, manyTill, noneOf, parse, setInput, statePos-                   , string, try, updateParserState, (<|>)-                   )-import Text.Parsec.String (Parser)--data StringPart = Lit String | Esc Char | AntiInject String | AntiParam (Q Exp)--data HsChompState = HsChompState { quoteState :: QuoteState-                                 , braceCt :: Int-                                 , consumed :: String-                                 , prevCharWasIdentChar :: Bool-                                 }--data QuoteState = None | Single EscapeState | Double EscapeState deriving (Eq, Ord, Show)--data EscapeState = Escaped | Unescaped deriving (Bounded, Enum, Eq, Ord, Show)--parseInterpolated :: String -> Either ParseError [StringPart]-parseInterpolated = parse pInterp ""--pInterp :: Parser [StringPart]-pInterp = manyTill pStringPart eof--pStringPart :: Parser StringPart-pStringPart = pAntiInject <|> pAntiParam <|> pEsc <|> pLit--pAntiInject :: Parser StringPart-pAntiInject = AntiInject <$> between (try pAntiOpenInject) pAntiClose pAntiName--pAntiOpenInject :: Parser String-pAntiOpenInject = string "!{"--pAntiName :: Parser String-pAntiName = manyTill anyChar (lookAhead pAntiClose)--pAntiParam :: Parser StringPart-pAntiParam = AntiParam <$> between (try pAntiOpenParam) pAntiClose pAntiExpr--pAntiOpenParam :: Parser String-pAntiOpenParam = string "${"--pAntiExpr :: Parser (Q Exp)-pAntiExpr = pUntilUnbalancedCloseBrace >>= either fail (pure . pure) . parseExp--pAntiClose :: Parser String-pAntiClose = string "}"--pUntilUnbalancedCloseBrace :: Parser String-pUntilUnbalancedCloseBrace = evalStateT go $ HsChompState None 0 "" False-  where-    go = do-      c <- lift anyChar-      modify $ \st@HsChompState {consumed} -> st {consumed = c:consumed}-      HsChompState{..} <- get-      let next = setIdentifierCharState c *> go-      case quoteState of-        None -> case c of-          '{' -> incBraceCt 1 *> next-          '}' | braceCt > 0 -> incBraceCt (-1) *> next-              | otherwise -> stepBack $> reverse (tail consumed)-          '\'' -> unless prevCharWasIdentChar (setQuoteState $ Single Unescaped)-               *> next-          '"' -> setQuoteState (Double Unescaped) *> next-          _ -> next-        Single Unescaped -> do case c of '\\' -> setQuoteState (Single Escaped)-                                         '\'' -> setQuoteState None-                                         _ -> pure ()-                               next-        Single Escaped -> setQuoteState (Single Unescaped) *> next-        Double Unescaped -> do case c of '\\' -> setQuoteState (Double Escaped)-                                         '"' -> setQuoteState None-                                         _ -> pure ()-                               next-        Double Escaped -> setQuoteState (Double Unescaped) *> next-    stepBack = lift $-      updateParserState-        (\s -> s {statePos = incSourceColumn (statePos s) (-1)})-        *> getInput-        >>= setInput . ('}':)-    incBraceCt n = modify $ \st@HsChompState {braceCt} ->-      st {braceCt = braceCt + n}-    setQuoteState qs = modify $ \st -> st {quoteState = qs}-    setIdentifierCharState c = modify $ \st ->-      st-        {prevCharWasIdentChar = or [isLetter c, isDigit c, c == '_', c == '\'']}--pEsc :: Parser StringPart-pEsc = Esc <$> (char '\\' *> anyChar)--pLit :: Parser StringPart-pLit = fmap Lit $-  try (litCharTil $ try $ lookAhead pAntiOpenInject <|> lookAhead pAntiOpenParam <|> lookAhead (string "\\"))-    <|> litCharTil eof-  where litCharTil = manyTill $ noneOf ['\\']
tests/Main.hs view
@@ -6,8 +6,13 @@ import Data.Char (toLower) import Data.Function ((&)) import qualified Database.SQLite.Simple as SQL-import Database.SQLite.Simple.QQ.Interpolated+import Database.SQLite.Simple.Interpolate +data Person = Person {name :: String, age :: Integer}++instance SQL.ToRow Person where+  toRow p = SQL.toRow (name p, age p)+ table :: String table = "people" @@ -16,13 +21,18 @@   print [isql|CREATE TABLE !{table} (name TEXT, age INTEGER)|]   conn & [iexecute|CREATE TABLE !{table} (name TEXT, age INTEGER)|] -  print [isql|INSERT INTO !{table} VALUES ("clive", 40)|]-  conn & [iexecute|INSERT INTO !{table} VALUES ("clive", 40)|]+  let name = "clive"+  print [isql|INSERT INTO !{table} VALUES ({name}, 40)|]+  conn & [iexecute|INSERT INTO !{table} VALUES ({name}, 40)|] -  ageSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))-  print (ageSum :: Int)+  let clara = Person {name = "clara", age = 25}+  print [isql|INSERT INTO !{table} VALUES @{clara}|]+  conn & [iexecute|INSERT INTO !{table} VALUES @{clara}|] -  let limit = 1 :: Int-  print [isql|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]-  ages <- conn & [iquery|SELECT age FROM !{table} WHERE name = ${map toLower "CLIVE"} LIMIT ${limit}|]-  print (ages :: [SQL.Only Int])+  ageHaskellSum <- conn & [ifold|SELECT age FROM !{table}|] 0 (\acc (SQL.Only x) -> pure (acc + x))+  print (ageHaskellSum :: Int)++  let minAge = 1 :: Int+  print [isql|SELECT AVG(age) FROM !{table} WHERE age >= {minAge}|]+  [ageAvg] <- conn & [iquery|SELECT AVG(age) FROM !{table} WHERE age >= {minAge}|]+  print (ageAvg :: SQL.Only Double)