diff --git a/Database/SQLite/Simple/FromField.hs b/Database/SQLite/Simple/FromField.hs --- a/Database/SQLite/Simple/FromField.hs +++ b/Database/SQLite/Simple/FromField.hs @@ -195,6 +195,9 @@ fromField f = returnError ConversionFailed f "expecting SQLText column type" +instance FromField SQLData where + fromField f = Ok (fieldData f) + fieldTypename :: Field -> String fieldTypename = B.unpack . gettypename . result diff --git a/Database/SQLite/Simple/QQ.hs b/Database/SQLite/Simple/QQ.hs new file mode 100644 --- /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/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.4.16.0 + * Add FromField instance for SQLData (thanks @LindaOrtega, @Shimuuar) + * Add QuasiQuoter sql (thanks @vrom911) + 0.4.15.0 * Support GHC 8.4.1 (Add instance Semigroup Query) (thanks @gwils!) diff --git a/sqlite-simple.cabal b/sqlite-simple.cabal --- a/sqlite-simple.cabal +++ b/sqlite-simple.cabal @@ -1,5 +1,5 @@ Name: sqlite-simple -Version: 0.4.15.0 +Version: 0.4.16.0 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple. @@ -35,6 +35,7 @@ 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 @@ containers, direct-sqlite >= 2.3.13 && < 2.4, semigroups == 0.18.*, + template-haskell, text >= 0.11, time, transformers, @@ -81,6 +83,7 @@ , Errors , Fold , ParamConv + , QQ , Simple , Statement , TestImports @@ -103,4 +106,3 @@ , direct-sqlite , text , time - diff --git a/test/Main.hs b/test/Main.hs --- 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 Errors import Fold import ParamConv +import QQ import Simple import Statement import TestImports() @@ -54,6 +54,7 @@ , TestLabel "Utf8" . testUtf8Simplest , TestLabel "Utf8" . testBlobs , TestLabel "Instances" . testUserFromField + , TestLabel "Instances" . testSQLDataFromField , TestLabel "Fold" . testFolds , TestLabel "Statement" . testBind , TestLabel "Statement" . testDoubleBind @@ -62,6 +63,8 @@ , 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 --- /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 diff --git a/test/UserInstances.hs b/test/UserInstances.hs --- a/test/UserInstances.hs +++ b/test/UserInstances.hs @@ -1,8 +1,12 @@ {-# LANGUAGE DeriveDataTypeable #-} -module UserInstances (testUserFromField) where +module UserInstances ( + testUserFromField + ,testSQLDataFromField + ) where import Common +import Data.Int (Int64) import Data.Typeable (Typeable) import qualified Data.Text as T import Database.SQLite.Simple.FromField @@ -31,3 +35,24 @@ execute conn "INSERT INTO fromfield (t) VALUES (?)" (Only (MyType "test2")) [Only r] <- query_ conn "SELECT t FROM fromfield" :: IO [(Only String)] "toField test2" @=? r + +testSQLDataFromField :: TestEnv -> Test +testSQLDataFromField TestEnv{..} = TestCase $ do + execute_ conn "CREATE TABLE sqldatafromfield (t TEXT, i INT, b BOOLEAN, f FLOAT)" + execute conn "INSERT INTO sqldatafromfield (t,i,b,f) VALUES (?,?,?,?)" (("test string" :: T.Text, + 1 :: Int64, + True :: Bool, + 1.11 :: Double)) + execute conn "INSERT INTO sqldatafromfield (t,i,b) VALUES (?,?,?)" (("test string2" :: T.Text, + 2 :: Int64, + False :: Bool)) + r <- query_ conn "SELECT * FROM sqldatafromfield" :: IO [[SQLData]] + let testData = [[SQLText "test string", + SQLInteger 1, + SQLInteger 1, + SQLFloat 1.11], + [SQLText "test string2", + SQLInteger 2, + SQLInteger 0, + SQLNull]] + testData @=? r