sqlite-simple 0.4.3.0 → 0.4.3.1

raw patch · 5 files changed

+133/−9 lines, 5 files

Files

• sqlite-simple.cabal +12/−9
• test/Debug.hs +29/−0
• test/DirectSqlite.hs +23/−0
• test/Fold.hs +19/−0
• test/Statement.hs +50/−0

@@ -1,5 +1,5 @@ Name:                sqlite-simple-Version:             0.4.3.0+Version:             0.4.3.1 Synopsis:            Mid-Level SQLite client library Description:     Mid-level SQLite client library, based on postgresql-simple.@@ -67,14 +67,17 @@    hs-source-dirs: test   main-is:        Main.hs-  other-modules:-    Common-    Simple-    Errors-    ParamConv-    Utf8Strings-    TestImports-    UserInstances+  other-modules:  Common+                , Debug+                , DirectSqlite+                , Errors+                , Fold+                , ParamConv+                , Simple+                , Statement+                , TestImports+                , UserInstances+                , Utf8Strings    ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind 

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Debug (+    testDebugTracing) where++import Control.Concurrent+import Common++-- Simplest SELECT+testDebugTracing :: TestEnv -> Test+testDebugTracing TestEnv{..} = TestCase $ do+  chan <- newChan+  let logger m = writeChan chan m+  setTrace conn (Just logger)+  execute_ conn "SELECT null"+  msg <- readChan chan+  "SELECT null" @=? msg+  execute conn "SELECT 1+?" (Only (2 :: Int))+  execute conn "SELECT 1+?" (Only (3 :: Int))+  msg <- readChan chan+  "SELECT 1+2" @=? msg+  msg <- readChan chan+  "SELECT 1+3" @=? msg+  -- Check that disabling works too+  setTrace conn Nothing+  execute_ conn "SELECT null"+  writeChan chan "empty"+  msg <- readChan chan+  "empty" @=? msg

@@ -0,0 +1,23 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++module DirectSqlite (+    testDirectSqlite+  ) where++import Common++import Control.Exception (bracket)+import qualified Database.SQLite3 as DS++testDirectSqlite :: TestEnv -> Test+testDirectSqlite TestEnv{..} = TestCase $ do+  let dsConn = connectionHandle conn+  bracket (DS.prepare dsConn "SELECT 1+1") DS.finalize testDirect+  [Only (res :: Int)] <- query_ (Connection dsConn) "SELECT 1+2"+  assertEqual "1+2" 3 res+  where+    testDirect stmt = do+      DS.Row <- DS.step stmt+      res <- DS.column stmt 0+      assertEqual "1+1" (SQLInteger 2) res

@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++module Fold (+    testFolds) where++import Common++testFolds :: TestEnv -> Test+testFolds TestEnv{..} = TestCase $ do+  execute_ conn "CREATE TABLE testf (id INTEGER PRIMARY KEY, t INT)"+  execute_ conn "INSERT INTO testf (t) VALUES (4)"+  execute_ conn "INSERT INTO testf (t) VALUES (5)"+  execute_ conn "INSERT INTO testf (t) VALUES (6)"+  val <- fold_ conn "SELECT id,t FROM testf" ([],[]) sumValues+  assertEqual "fold_" ([3,2,1], [6,5,4]) val+  val <- fold conn "SELECT id,t FROM testf WHERE id > ?" (Only (1 :: Int)) ([],[]) sumValues+  assertEqual "fold" ([3,2], [6,5]) val+  where+    sumValues (accId, accT) (id_ :: Int, t :: Int) = return $ (id_ : accId, t : accT)

@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Statement (+    testBind+  , testDoubleBind+  , testPreparedStatements+  ) where++import Common+import Data.Maybe(fromJust)++testBind :: TestEnv -> Test+testBind TestEnv{..} = TestCase $ do+  execute_ conn "CREATE TABLE test_bind (id INTEGER PRIMARY KEY, t TEXT)"+  execute_ conn "INSERT INTO test_bind VALUES(1, 'result')"+  withStatement conn "SELECT t FROM test_bind WHERE id=?" $ \stmt ->+    withBind stmt [1::Int] $ do+      row <- nextRow stmt :: IO (Maybe (Only String))+      assertEqual "result" (Only "result") (fromJust row)++testDoubleBind :: TestEnv -> Test+testDoubleBind TestEnv{..} = TestCase $ do+  execute_ conn "CREATE TABLE test_double_bind (id INTEGER PRIMARY KEY, t TEXT)"+  execute_ conn "INSERT INTO test_double_bind VALUES(1, 'first result')"+  execute_ conn "INSERT INTO test_double_bind VALUES(2, 'second result')"+  withStatement conn "SELECT t FROM test_double_bind WHERE id=?" $ \stmt -> do+    withBind stmt [1::Int] $ do+      row <- nextRow stmt :: IO (Maybe (Only String))+      assertEqual "first result" (Only "first result") (fromJust row)++    withBind stmt [2::Int] $ do+      row <- nextRow stmt :: IO (Maybe (Only String))+      assertEqual "second result" (Only "second result") (fromJust row)++testPreparedStatements :: TestEnv -> Test+testPreparedStatements TestEnv{..} = TestCase $ do+  execute_ conn "CREATE TABLE ps (id INTEGER PRIMARY KEY, t TEXT)"+  execute_ conn "INSERT INTO ps VALUES(1, 'first result')"+  execute_ conn "INSERT INTO ps VALUES(2, 'second result')"+  withStatement conn "SELECT t FROM ps WHERE id=?" $ \stmt -> do+    colName <- columnName stmt 0+    colName @?= "t"+    elems <- mapM (queryOne stmt) [1 :: Int, 2]+    ["first result" :: String, "second result"] @=? elems+    where+      queryOne stmt rowId =+        withBind stmt (Only rowId) $ do+          Just (Only r) <- nextRow stmt+          Nothing <- nextRow stmt :: IO (Maybe (Only String))+          return r