sqlite-easy 1.0.1.0 → 1.1.0.0

raw patch · 6 files changed

+75/−4 lines, 6 files

Files

• LICENSE +1/−1
• changelog.md +9/−0
• sqlite-easy.cabal +1/−1
• src/Database/Sqlite/Easy.hs +2/−0
• src/Database/Sqlite/Easy/Internal.hs +34/−2
• test/SqliteEasySpec.hs +28/−0

@@ -1,4 +1,4 @@-Copyright (c) 2022-2023, Gil Mizrahi+Copyright (c) 2022-2024, Gil Mizrahi  All rights reserved. 

@@ -1,3 +1,12 @@+### 1.1.0.0++* Add `openWith` and `createSqlitePoolWith`.+* `createSqlitePool` will now set the `foreign_keys` pragma and the `busy_timeout` pragma to 30000ms.++### 1.0.1.0++* Fix compilation with direct-sqlite 2.3.29.+ ### 1.0.0.0  * Bump resource-pool bounds to >=0.4 && <5.

@@ -1,7 +1,7 @@ cabal-version: 2.4  name: sqlite-easy-version: 1.0.1.0+version: 1.1.0.0 synopsis: A primitive yet easy to use sqlite library. description: A primitive yet easy to use sqlite library built using sqlite-direct, resource-pool and migrant. author: Gil Mizrahi

@@ -6,12 +6,14 @@     -- $connecting     withDb   , withDatabase+  , openWith   , ConnectionString(..)   , Database     -- ** Pooling connections     -- $pooling   , Pool   , createSqlitePool+  , createSqlitePoolWith   , withPool   , withResource   , destroyAllResources

@@ -12,6 +12,7 @@ import qualified Database.SQLite3 as Direct import Data.String (IsString, fromString) import Data.Text (Text)+import qualified Data.Text as T import Data.Typeable import Data.Pool import Control.Monad.Reader@@ -29,13 +30,44 @@   deriving Show  -- | Create a pool of a sqlite3 db with a specific connection string.+--   This also sets a few default pragmas. createSqlitePool :: ConnectionString -> IO (Pool Database)-createSqlitePool (ConnectionString connStr) =+createSqlitePool connStr =   newPool $ defaultPoolConfig-    (Direct.open connStr)+    (openWith connStr defaultPragmas)     Direct.close     180     50++-- | Create a pool of a sqlite3 db with a specific connection string.+--   This will also run the supplied SQL statements after establishing+--   each connection.+createSqlitePoolWith :: ConnectionString -> [SQL] -> IO (Pool Database)+createSqlitePoolWith connStr statements =+  newPool $ defaultPoolConfig+    (openWith connStr statements)+    Direct.close+    180+    50++-- | Open a connection to a database, run the supplied statements,+--   and return the connection.+openWith :: ConnectionString -> [SQL] -> IO Database+openWith (ConnectionString connStr) sqls = do+  conn <- Direct.open connStr+  Direct.exec+    conn+    (T.unlines $ map (\(SQL sql) -> sql <> "; ") sqls)+  pure conn++-- | Default pragmas to be set when opening a connection from a pool.+defaultPragmas :: [SQL]+defaultPragmas =+  [ -- https://www.sqlite.org/pragma.html#pragma_foreign_keys+    "PRAGMA foreign_keys = on"+  , -- https://www.sqlite.org/pragma.html#pragma_busy_timeout+    "PRAGMA busy_timeout = 30000"+  ]  -- | Open a database, run some stuff, close the database. withDb :: ConnectionString -> SQLite a -> IO a

@@ -1,3 +1,4 @@+{-# language ViewPatterns #-} {-# language OverloadedStrings #-} {-# language ScopedTypeVariables #-} @@ -7,6 +8,7 @@ import Test.Hspec import Database.Sqlite.Easy import UnliftIO.Exception (try, catch, displayException, SomeException(..))+import GHC.Conc (forkIO, threadDelay)  spec :: Spec spec = do@@ -114,3 +116,29 @@         run "select * from t"       destroyAllResources pool       shouldBe result [[SQLInteger 1]]++  describe "concurrency" $ do+    it "write concurrently to default pool" $ do+      pool <- createSqlitePool "/tmp/sqlite-easy-test.db"+      let table = "test_conc"+      withPool pool $ do+        [] <- run $ "drop table if exists " <> table+        [] <- run $ "create table " <> table <> "(x int not null)"+        pure ()+      forkIO $ withPool pool $ transaction $ do+        liftIO $ threadDelay 100000+        [] <- run $ "insert into " <> table <> " values (2)"+        pure ()+      liftIO $ threadDelay 50000+      forkIO $ withPool pool $ transaction $ do+        [] <- run $ "insert into " <> table <> " values (1)"+        liftIO $ threadDelay 100000+        pure ()+      liftIO $ threadDelay 80000+      readerResult <- withPool pool $ transaction $ do+        run $ "select * from " <> table+      liftIO $ threadDelay 200000+      result <- withPool pool $ do+        run $ "select * from " <> table <> " order by rowid"+      destroyAllResources pool+      shouldBe (readerResult, result) ([], [[SQLInteger 1], [SQLInteger 2]])