diff --git a/.gitignore b/.gitignore index 50ae256..5ce26b9 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ TAGS /*.hs.html /hpc_*.html /test.tix +.stack-work/ diff --git a/Database/SQLite/Simple/QQ.hs b/Database/SQLite/Simple/QQ.hs new file mode 100644 index 0000000..53172bc --- /dev/null +++ b/Database/SQLite/Simple/QQ.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE TemplateHaskell #-} + +------------------------------------------------------------------------------ +-- | +-- Module: Database.SQLite.Simple.QQ +-- Copyright: (c) 2011-2012 Leon P Smith +-- (c) 2018 Janne Hellsten +-- License: BSD3 +-- Maintainer: Janne Hellsten +-- Portability: portable +-- +-- The 'sql' quasiquoter, for writing large @SQL@ statements. +-- +------------------------------------------------------------------------------ + +module Database.SQLite.Simple.QQ + ( sql + ) where + +import Data.String (fromString) +import Database.SQLite.Simple.Types (Query) +import Language.Haskell.TH (Exp, Q, appE, stringE) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) + +{- | A quasiquoter for writing big @SQL@ queries. + +One should consider turning on the @-XQuasiQuotes@ pragma in that module: + +@ +{-# LANGUAGE QuasiQuoter #-} + +myQuery = query conn [sql| + SELECT + * + FROM + users + WHERE jobTitle = ? + |] jobTitle +@ + +-} +sql :: QuasiQuoter +sql = QuasiQuoter + { quotePat = error "Database.SQLite.Simple.QQ.sql: quasiquoter used in pattern context" + , quoteType = error "Database.SQLite.Simple.QQ.sql: quasiquoter used in type context" + , quoteDec = error "Database.SQLite.Simple.QQ.sql: quasiquoter used in declaration context" + , quoteExp = sqlExp + } + +sqlExp :: String -> Q Exp +sqlExp = appE [| fromString :: String -> Query |] . stringE diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal index 92c1817..6be9c26 100644 --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -35,6 +35,7 @@ Library Database.SQLite.Simple.FromField Database.SQLite.Simple.FromRow Database.SQLite.Simple.Internal + Database.SQLite.Simple.QQ Database.SQLite.Simple.ToField Database.SQLite.Simple.ToRow Database.SQLite.Simple.Types @@ -50,6 +51,7 @@ Library containers, direct-sqlite >= 2.3.13 && < 2.4, semigroups == 0.18.*, + template-haskell, text >= 0.11, time, transformers, @@ -81,6 +83,7 @@ test-suite test , Errors , Fold , ParamConv + , QQ , Simple , Statement , TestImports @@ -103,4 +106,3 @@ test-suite test , direct-sqlite , text , time - diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..c332fca --- /dev/null +++ b/stack.yaml @@ -0,0 +1 @@ +resolver: lts-11.9 diff --git a/test/Main.hs b/test/Main.hs index b11c807..39bc4b2 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,4 +1,3 @@ - import Common import Control.Exception (bracket) import Control.Monad (when) @@ -10,6 +9,7 @@ import DirectSqlite import Errors import Fold import ParamConv +import QQ import Simple import Statement import TestImports() @@ -63,6 +63,8 @@ tests = , TestLabel "Debug" . testDebugTracing , TestLabel "Direct" . testDirectSqlite , TestLabel "Imports" . testImports + , TestLabel "QQ" . testSimpleQQ + , TestLabel "QQ" . testMultiLinedQQ ] -- | Action for connecting to the database that will be used for testing. diff --git a/test/QQ.hs b/test/QQ.hs new file mode 100644 index 0000000..923c6b5 --- /dev/null +++ b/test/QQ.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE QuasiQuotes #-} + +module QQ ( + testSimpleQQ + , testMultiLinedQQ + ) where + +import Common +import Database.SQLite.Simple.QQ (sql) + +testSimpleQQ :: TestEnv -> Test +testSimpleQQ TestEnv{..} = TestCase $ do + q <- query_ conn "SELECT 1+1" :: IO [Only Int] + qq <- query_ conn [sql| + SELECT 1 + 1 + |] :: IO [Only Int] + assertEqual "result" q qq + + +testMultiLinedQQ :: TestEnv -> Test +testMultiLinedQQ TestEnv{..} = TestCase $ do + execute_ conn "CREATE TABLE testQQ (id INTEGER PRIMARY KEY, t TEXT)" + execute_ conn "INSERT INTO testQQ (t) VALUES ('test string')" + q <- query_ conn "SELECT t FROM testQQ" :: IO [Only String] + qq <- query_ conn [sql| + SELECT + t + FROM + testQQ + + |] :: IO [Only String] + assertEqual "result" q qq