Merge pull request #61 from vrom911/vrom911/qq

Add QuasiQuoter sql and tests

.gitignore

@@ -4,3 +4,4 @@ TAGS
 /*.hs.html
 /hpc_*.html
 /test.tix
+.stack-work/

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 <jjhellst@gmail.com>
+-- 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

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
-

stack.yaml

@@ -0,0 +1 @@
+resolver: lts-11.9

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.

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