diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -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` diff --git a/sqlite-easy.cabal b/sqlite-easy.cabal --- a/sqlite-easy.cabal +++ b/sqlite-easy.cabal @@ -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 diff --git a/src/Database/Sqlite/Easy.hs b/src/Database/Sqlite/Easy.hs --- a/src/Database/Sqlite/Easy.hs +++ b/src/Database/Sqlite/Easy.hs @@ -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: - + -} diff --git a/src/Database/Sqlite/Easy/Internal.hs b/src/Database/Sqlite/Easy/Internal.hs --- a/src/Database/Sqlite/Easy/Internal.hs +++ b/src/Database/Sqlite/Easy/Internal.hs @@ -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: -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) diff --git a/src/Database/Sqlite/Easy/Migrant.hs b/src/Database/Sqlite/Easy/Migrant.hs --- a/src/Database/Sqlite/Easy/Migrant.hs +++ b/src/Database/Sqlite/Easy/Migrant.hs @@ -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 ] diff --git a/test/SqliteEasySpec.hs b/test/SqliteEasySpec.hs --- a/test/SqliteEasySpec.hs +++ b/test/SqliteEasySpec.hs @@ -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]]