packages feed

sqlite-easy 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+277/−126 lines, 7 filesdep +mtldep +unliftiodep +unliftio-core

Dependencies added: mtl, unliftio, unliftio-core

Files

README.md view
@@ -6,4 +6,5 @@  It might be useful for small toy projects and save a tiny bit of boilerplate. -[See the docs for more information](https://gilmi.gitlab.io/sqlite-easy/haddocks/sqlite-easy-0.1.0.0/Database-Sqlite-Easy.html)!+- [See the docs for more information](https://hackage.haskell.org/package/sqlite-easy)+- [See an example app](https://github.com/soupi/sqlite-easy-example-todo)
+ changelog.md view
@@ -0,0 +1,9 @@+### 0.2.0.0++* Rework the API+  * Introduce the `SQLite a` type instead of `Database -> IO a` for `run`, `runWith`, `withDB`, `migrate`, and so on.+  * Introduce `withPool` and export `liftIO`, `fromString` and `void`.+  * Depend on `unliftio-core` and `mtl`.+* Implement nested transactions via savepoints.+  * `asTransaction` renamed to `transaction`+  * `cancelTransaction` split to `rollback` and `rollbackAll`
sqlite-easy.cabal view
@@ -1,19 +1,21 @@ cabal-version: 2.4 -name:           sqlite-easy-version:        0.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-category:       Database-stability:      Experimental-maintainer:     gilmi@posteo.net-copyright:      2022 Gil Mizrahi-license:        BSD-3-Clause-license-file:   LICENSE-build-type:     Simple+name: sqlite-easy+version: 0.2.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+category: Database+stability: Experimental+maintainer: gilmi@posteo.net+copyright: 2022 Gil Mizrahi+license: BSD-3-Clause+license-file: LICENSE+homepage: https://gitlab.com/gilmi/sqlite-easy+build-type: Simple extra-source-files:     README.md+    changelog.md --    cbits/sqlite3.c --    cbits/sqlite3.h @@ -28,6 +30,8 @@       base >=4.12 && <5     , bytestring     , text+    , mtl+    , unliftio-core     , direct-sqlite     , resource-pool     , migrant-core@@ -56,6 +60,7 @@     , sqlite-easy     , text     , direct-sqlite+    , unliftio   default-language: Haskell2010   ghc-options:     -threaded -rtsopts -with-rtsopts=-N
src/Database/Sqlite/Easy.hs view
@@ -5,18 +5,23 @@   ( -- * Connect to the database     -- $connecting     withDb+  , withDatabase   , ConnectionString(..)   , Database     -- ** Pooling connections     -- $pooling   , Pool   , createSqlitePool+  , withPool   , withResource   , destroyAllResources     -- * Running statements and queries     -- $running   , run   , runWith+  , SQLite+  , liftIO+  , fromString   , -- ** Database types     SQL   , SQLData(..)@@ -24,11 +29,13 @@   , ColumnType(..)     -- * Running transactions     -- $transactions-  , asTransaction-  , cancelTransaction+  , transaction+  , rollback+  , rollbackAll   , -- * Migrations     -- $migrations-    module Migrant+    module Migrant,+    void   , -- * Fun types to export     Int64, Text, ByteString     -- * Suggestions@@ -36,14 +43,17 @@   )   where -import Data.Pool (Pool, withResource, destroyAllResources)+import Data.Pool (Pool, destroyAllResources, withResource) import Database.SQLite3 (SQLData(..), Database, SQLError(..), ColumnType(..)) import Database.Sqlite.Easy.Internal import Database.Sqlite.Easy.Migrant as Migrant-import Database.Migrant as Migrant+import Database.Migrant as Migrant hiding (migrate) import Data.Int (Int64) import Data.Text (Text) import Data.ByteString (ByteString)+import Data.String (fromString)+import Control.Monad.Reader (liftIO)+import Control.Monad (void)  {- $connecting @@ -76,13 +86,14 @@ We can use the 'createSqlitePool' function to create a @Pool 'Database'@ and pass that around until you are ready to use the database. -We can use 'withResource' to essentially make 'withDb' from a pool.+We can use 'withPool' like we did with 'withDb' but passing a 'Database'+instead of a 'ConnectionString'.  === Example  > do >   pool <- createSqlitePool ":memory:"->   results <- withResource pool (run "select 1 + 1")+>   results <- withPool pool (run "select 1 + 1") >   case results of >     [[SQLInteger n]] -> print n >     _ -> error ("Got unexpected results: " <> show results)@@ -111,35 +122,40 @@ === Example  > do->   results <- withDb ":memory:" $ \db -> do->     [] <- run "CREATE TABLE characters(id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT)" db->     [] <- run "INSERT INTO characters(name) VALUES ('Scanlan'),('Nott'),('Fresh Cut Grass')" db->     runWith "SELECT * FROM characters WHERE id = ?" [SQLInteger 2] db+>   results <- withDb ":memory:" $ do+>     [] <- run "CREATE TABLE characters(id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT)"+>     [] <- run "INSERT INTO characters(name) VALUES ('Scanlan'),('Nott'),('Fresh Cut Grass')"+>     runWith "SELECT * FROM characters WHERE id = ?" [SQLInteger 2] > >   for_ results $ \case >     [SQLInteger id', SQLText name] -> putStrLn (show id' <> ", " <> show name) >     row -> hPutStrLn stderr ("Unexpected row: " <> show row)+ -}  {- $transactions -If you'd like to run multiple statements and queries atomically, use 'asTransaction'.-Please note that sqlite transactions do not nest.+If you'd like to run multiple statements and queries atomically, use 'transaction'.  === Example -> withDb ":memory:" $ \db -> do->   asTransaction db $ do->     [] <- run "CREATE TABLE t1(id INTEGER, name TEXT)" db->     [] <- run "CREATE TABLE t2(id INTEGER, name TEXT)" db->     [] <- run "CREATE TABLE t3id INTEGER, name TEXT)" db -- whoops->     [] <- run "CREATE TABLE t4(id INTEGER, name TEXT)" db->     pure ()->   run "select * from t1" db -- throws an exception (table not found) because the transaction was rolled back+> withDb ":memory:" $ do+>   ( transaction $ do+>       [] <- run "CREATE TABLE t1(id INTEGER, name TEXT)"+>       [] <- run "CREATE TABLE t2(id INTEGER, name TEXT)"+>       [] <- run "CREATE TABLE t3id INTEGER, name TEXT)" -- whoops+>       [] <- run "CREATE TABLE t4(id INTEGER, name TEXT)"+>       pure ()+>     ) `catch` (\(SomeException e) -> liftIO $ print ("Transaction rolled back", e))+>   run "select * from t1" -- throws an exception (table not found) because the transaction was rolled back -You can also decide to cancel a transaction yourself by supplying the result value-with 'cancelTransaction'.+You can also decide to rollback the current transaction yourself by supplying the result value+with 'rollback', or rollback all transactions with 'rollbackAll'. +Note, catching an exception from within 'SQLite' as was done in the previous+snippet is not recommended because it can mix with rollback code,+but it can be done using the 'unliftio' package.+ -}  {- $migrations@@ -165,29 +181,29 @@  2) Migration up steps - a mapping from migration name to what to do. -> migrateUp :: MigrationName -> Database -> IO ()+> migrateUp :: MigrationName -> SQLite () > migrateUp = \case >   "user-table" ->->     void . run "CREATE TABLE user(id INTEGER, name TEXT)"+>     void (run "CREATE TABLE user(id INTEGER, name TEXT)") >   "article-table" ->->     void . run "CREATE TABLE article(id integer, title TEXT, content TEXT, author_id integer)"+>     void (run "CREATE TABLE article(id integer, title TEXT, content TEXT, author_id integer)") >   unknown -> >     error ("Unexpected migration: " <> show unknown)  3) Migration down steps -> migrateDown :: MigrationName -> Database -> IO ()+> migrateDown :: MigrationName -> SQLite () > migrateDown = \case >   "user-table" ->->     void . run "DROP TABLE user"+>     void (run "DROP TABLE user") >   "article-table" ->->     void . run "DROP TABLE article"+>     void (run "DROP TABLE article") >   unknown -> >     error ("Unexpected migration: " <> show unknown)  After doing that, we can run a migration with the 'migrate' function: -> runMigrations :: Database -> IO ()+> runMigrations :: SQLite () > runMigrations = migrate migrations migrateUp migrateDown  -}@@ -224,8 +240,8 @@  > mkDB :: ConnectionString -> IO DB > mkDB connectionString = do->   pool <- DB.createSqlitePool connstr->   DB.withResource pool runMigrations+>   pool <- createSqlitePool connectionString+>   withPool pool runMigrations >   pure $ DB >     { getPost = getPostFromDb pool >     , getPosts = getPostsFromDb pool@@ -260,5 +276,5 @@ == Complete Example  Visit this link for a more complete example:-<https://github.com/soupi/learn-twain-bulletin-app/blob/sqlite/src/DB.hs>+<https://github.com/soupi/sqlite-easy-example-todo> -}
src/Database/Sqlite/Easy/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-# language DerivingVia #-} {-# language OverloadedStrings #-} {-# language ScopedTypeVariables #-}@@ -5,11 +6,13 @@ module Database.Sqlite.Easy.Internal where  import Database.SQLite3-import Data.String (IsString)+import Data.String (IsString, fromString) import Data.Text (Text)-import Control.Exception import Data.Typeable import Data.Pool+import Control.Monad.Reader+import Control.Exception+import Control.Monad.IO.Unlift  -- * Connection @@ -32,9 +35,18 @@     }  -- | Open a database, run some stuff, close the database.-withDb :: ConnectionString -> (Database -> IO a) -> IO a-withDb (ConnectionString connStr) = bracket (open connStr) close+withDb :: ConnectionString -> SQLite a -> IO a+withDb (ConnectionString connStr) =+  bracket (open connStr) close . flip runSQLite +-- | Use an active database connection to run some stuff on a database.+withDatabase :: Database -> SQLite a -> IO a+withDatabase = runSQLite++-- | Use a resource pool to run some stuff on a database.+withPool :: Pool Database -> SQLite a -> IO a+withPool pool = withResource pool . flip runSQLite+ -- * Execution  -- | A SQL statement@@ -46,15 +58,19 @@   deriving Show  -- | Run a SQL statement on a database and fetch the results.-run :: SQL -> Database -> IO [[SQLData]]-run (SQL stmt) db = prepare db stmt >>= fetchAll+run :: SQL -> SQLite [[SQLData]]+run (SQL stmt) = do+  db <- getDB+  liftIO (prepare db stmt >>= fetchAll)  -- | Run a SQL statement with certain parameters on a database and fetch the results.-runWith :: SQL -> [SQLData] -> Database -> IO [[SQLData]]-runWith (SQL stmt) params db = do-  preparedStmt <- prepare db stmt-  bind preparedStmt params-  fetchAll preparedStmt+runWith :: SQL -> [SQLData] -> SQLite [[SQLData]]+runWith (SQL stmt) params = do+  db <- getDB+  liftIO $ do+    preparedStmt <- prepare db stmt+    bind preparedStmt params+    fetchAll preparedStmt  -- | Run a statement and fetch all of the data. fetchAll :: Statement -> IO [[SQLData]]@@ -71,38 +87,96 @@  -- * Transaction +newtype SQLite a+  = SQLite+    { unSQLite :: SQLiteStuff -> IO a+    }+  deriving (Functor, Applicative, Monad, MonadIO, MonadFail, MonadUnliftIO)+  via ReaderT SQLiteStuff IO++instance Semigroup a => Semigroup (SQLite a) where+  a <> b = (<>) <$> a <*> b++instance Monoid a => Monoid (SQLite a) where+  mempty = pure mempty++data SQLiteStuff+  = SQLiteStuff+    { dbConn :: Database+    , transactionNumber :: Maybe Int+    }++getDB :: SQLite Database+getDB = SQLite (\(SQLiteStuff dbConn _) -> pure dbConn)++runSQLite :: Database -> SQLite a -> IO a+runSQLite db t = (unSQLite t) (SQLiteStuff db Nothing)+ -- | Run operations as a transaction. --   If the action throws an error, the transaction is rolled back.------   __Note__: Transactions do not nest.--- --   For more information, visit: <https://www.sqlite.org/lang_transaction.html>-asTransaction :: Typeable a => Database -> IO a -> IO a-asTransaction db action = do-  [] <- run "BEGIN" db-  catches-    (action <* run "COMMIT" db)-    [ Handler $ \(CancelTransaction a) -> run "ROLLBACK" db *> pure a-    , Handler $ \(ex :: SomeException) -> run "ROLLBACK" db *> throwIO ex-    ]+transaction :: forall a. Typeable a => SQLite a -> SQLite a+transaction action = do+  SQLiteStuff {..} <- SQLite $ \stuff -> pure stuff+  case transactionNumber of+    Nothing -> do+      let+        runIO sql = (unSQLite (run sql)) (SQLiteStuff dbConn Nothing)+        commit = runIO "COMMIT"+        rollback' = runIO "ROLLBACK"+      [] <- run "BEGIN"+      liftIO $ catches+        ((unSQLite action) (SQLiteStuff dbConn (Just 1)) <* commit)+        [ Handler $ \(RollbackCurrent a) -> rollback' *> pure a+        , Handler $ \(RollbackAll a) -> rollback' *> pure a+        , Handler $ \(ex :: SomeException) -> rollback' *> throwIO ex+        ]+    Just n -> do+      let+        runIO sql = (unSQLite (run sql)) (SQLiteStuff dbConn Nothing)+        transactionName = "'sqlite_easy_transaction_" <> fromString (show n) <> "'"+        release = runIO $ "RELEASE SAVEPOINT " <> transactionName+        rollbackCurrent = runIO $ "ROLLBACK TRANSACTION TO SAVEPOINT " <> transactionName+      [] <- run $ "SAVEPOINT " <> transactionName+      liftIO $ catches+        ((unSQLite action) (SQLiteStuff dbConn (Just (n + 1))) <* release)+        [ Handler $ \(RollbackCurrent a) -> rollbackCurrent *> pure a+        , Handler $ \(ex :: RollbackAll a) -> rollbackCurrent *> throwIO ex+        , Handler $ \(ex :: SomeException) -> rollbackCurrent *> throwIO ex+        ]  asTransaction' :: Database -> IO a -> IO a asTransaction' db action = do-  [] <- run "BEGIN" db+  let+    runIO sql = (unSQLite (run sql)) (SQLiteStuff db Nothing)+  [] <- runIO "BEGIN"   catches-    (action <* run "COMMIT" db)-    [ Handler $ \(ex :: SomeException) -> run "ROLLBACK" db *> throwIO ex+    (action <* runIO "COMMIT")+    [ Handler $ \(ex :: SomeException) -> runIO "ROLLBACK" *> throwIO ex     ] --- | Cancel a transaction by supplying the return value.+-- | Rollback the current (inner-most) transaction by supplying the return value. --   To be used inside transactions.-cancelTransaction :: Typeable a => a -> IO a-cancelTransaction = throwIO . CancelTransaction+rollback :: Typeable a => a -> SQLite a+rollback = liftIO . throwIO . RollbackCurrent -data CancelTransaction a-  = CancelTransaction a+-- | Rollback all transaction structure by supplying the return value.+--   To be used inside transactions.+rollbackAll :: Typeable a => a -> SQLite a+rollbackAll = liftIO . throwIO . RollbackAll -instance Show (CancelTransaction a) where-  show CancelTransaction{} = "CancelTransaction"+data RollbackCurrent a+  = RollbackCurrent a -instance (Typeable a) => Exception (CancelTransaction a)+instance Show (RollbackCurrent a) where+  show RollbackCurrent{} = "RollbackCurrent"++instance (Typeable a) => Exception (RollbackCurrent a)++data RollbackAll a+  = RollbackAll a++instance Show (RollbackAll a) where+  show RollbackAll{} = "RollbackAll"++instance (Typeable a) => Exception (RollbackAll a)
src/Database/Sqlite/Easy/Migrant.hs view
@@ -1,39 +1,57 @@-{-#LANGUAGE OverloadedStrings #-}+{-# language OverloadedStrings #-}+ module Database.Sqlite.Easy.Migrant   ( module Database.Migrant.Driver.Class+  , migrate   )   where +import qualified Database.Migrant as Migrant import Database.Migrant.Driver.Class import Database.Migrant.MigrationName import qualified Database.Sqlite.Easy.Internal as Sqlite import qualified Database.SQLite3 as Sqlite+import Control.Monad (void) +-- | Execute a migration against the database.+--   A wrapper around migrant's 'Migrant.migrate' for SQLite.+migrate+  :: [MigrationName]+  -> (MigrationName -> Sqlite.SQLite ())+  -> (MigrationName -> Sqlite.SQLite ())+  -> Sqlite.SQLite ()+migrate migrations migrateUp migrateDown = Sqlite.SQLite $ \(Sqlite.SQLiteStuff database _) ->+  Migrant.migrate+    migrations+    (\name db -> void . Sqlite.withDatabase db $ migrateUp name)+    (\name db -> void . Sqlite.withDatabase db $ migrateDown name)+    database+ instance Driver Sqlite.Database where   withTransaction action conn = Sqlite.asTransaction' conn (action conn)    initMigrations conn = do-    [] <- Sqlite.run-      "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER PRIMARY KEY, name TEXT)"-      conn+    [] <- Sqlite.withDatabase conn $+      Sqlite.run+        "CREATE TABLE IF NOT EXISTS _migrations (id INTEGER PRIMARY KEY, name TEXT)"     pure ()    markUp name conn = do-    [] <- Sqlite.runWith-      "INSERT INTO _migrations (name) VALUES (?)"-      [Sqlite.SQLText $ unpackMigrationName name]-      conn+    [] <- Sqlite.withDatabase conn $+      Sqlite.runWith+        "INSERT INTO _migrations (name) VALUES (?)"+        [Sqlite.SQLText $ unpackMigrationName name]     pure ()    markDown name conn = do-    [] <- Sqlite.runWith-      "DELETE FROM _migrations WHERE name = ?"-      [Sqlite.SQLText $ unpackMigrationName name]-      conn+    [] <- Sqlite.withDatabase conn $+      Sqlite.runWith+        "DELETE FROM _migrations WHERE name = ?"+        [Sqlite.SQLText $ unpackMigrationName name]     pure ()    getMigrations conn = do-    result <- Sqlite.run-      "SELECT name FROM _migrations ORDER BY id"-       conn+    result <- Sqlite.withDatabase conn $+      Sqlite.run+        "SELECT name FROM _migrations ORDER BY id"     return [ MigrationName name | [Sqlite.SQLText name] <- result ]
test/SqliteEasySpec.hs view
@@ -5,66 +5,94 @@  import Test.Hspec import Database.Sqlite.Easy-import Control.Exception (try)+import UnliftIO.Exception (try)  spec :: Spec spec = do-  describe "sanity" $ do+  describe "basics" $ do     it "create insert select" $ do-      result <- withDb ":memory:" $ \db -> do-        [] <- run "create table t(x int not null)" db-        [] <- run "insert into t values (1),(2),(3)" db-        run "select * from t" db+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        [] <- run "insert into t values (1),(2),(3)"+        run "select * from t"       shouldBe         result         [[SQLInteger 1], [SQLInteger 2], [SQLInteger 3]]      it "select with params" $ do-      result <- withDb ":memory:" $ \db -> do-        [] <- run "create table t(x int not null)" db-        [] <- run "insert into t values (1),(2),(3)" db-        runWith "select * from t where x = ?" [SQLInteger 1] db+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        [] <- run "insert into t values (1),(2),(3)"+        runWith "select * from t where x = ?" [SQLInteger 1]       shouldBe         result         [[SQLInteger 1]]    describe "transactions" $ do     it "transaction is rolled back in case of error" $ do-      result <- withDb ":memory:" $ \db -> do-        [] <- run "create table t(x int not null)" db-        Left SQLError{} <- try $ asTransaction db $ do-          [] <- run "insert into t values (1)" db-          [] <- run "insert into t values (2" db+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        Left SQLError{} <- try $ transaction $ do+          [] <- run "insert into t values (1)"+          [] <- run "insert into t values (2"           pure ()-        run "select * from t" db+        run "select * from t"       shouldBe result []      it "transaction is commited" $ do-      result <- withDb ":memory:" $ \db -> do-        [] <- run "create table t(x int not null)" db-        (Right () :: Either SQLError ()) <- try $ asTransaction db $ do-          [] <- run "insert into t values (1)" db-          [] <- run "insert into t values (2)" db+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        (Right () :: Either SQLError ()) <- try $ transaction $ do+          [] <- run "insert into t values (1)"+          [] <- run "insert into t values (2)"           pure ()-        run "select * from t" db+        run "select * from t"       shouldBe result [[SQLInteger 1], [SQLInteger 2]]      it "transaction is cancelled" $ do-      result <- withDb ":memory:" $ \db -> do-        [] <- run "create table t(x int not null)" db-        (Right transactionResult :: Either SQLError [[SQLData]]) <- try $ asTransaction db $ do-          [] <- run "insert into t values (1)" db-          cancelTransaction []-        result <- run "select * from t" db+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        (Right transactionResult :: Either SQLError [[SQLData]]) <- try $ transaction $ do+          [] <- run "insert into t values (1)"+          rollback []+        result <- run "select * from t"         pure (transactionResult, result)       uncurry shouldBe result +    it "nested transaction is cancelled" $ do+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        transactionResult <-+          transaction $ do+            transactionResult <-+              transaction $ do+                [] <- run "insert into t values (1)"+                rollback [[SQLInteger 2]]+            run "insert into t values (2)"+            pure transactionResult+        result <- run "select * from t"+        pure (transactionResult, result)+      uncurry shouldBe result++    it "all transactions are cancelled" $ do+      result <- withDb ":memory:" $ do+        [] <- run "create table t(x int not null)"+        transactionResult <-+          transaction $ do+            _ :: [[SQLData]] <- transaction $ do+              [] <- run "insert into t values (1)"+              rollbackAll []+            run "insert into t values (2)"+        result <- run "select * from t"+        pure (transactionResult, result)+      uncurry shouldBe result+   describe "pool" $ do     it "create, use, and destroy" $ do       pool <- createSqlitePool ":memory:"-      result <- withResource pool $ \db -> do-        [] <- run "create table t(x int not null)" db-        [] <- run "insert into t values (1)" db-        run "select * from t" db+      result <- withPool pool $ do+        [] <- run "create table t(x int not null)"+        [] <- run "insert into t values (1)"+        run "select * from t"       destroyAllResources pool       shouldBe result [[SQLInteger 1]]