remove Unison.Sqlite.DB from unison-sqlite

lib/unison-sqlite/package.yaml

@@ -15,6 +15,7 @@ dependencies:
   - direct-sqlite
   - exceptions
   - mtl
+  - random
   - recover-rtti
   - sqlite-simple
   - text

lib/unison-sqlite/src/Unison/Sqlite.hs

@@ -8,18 +8,17 @@
 --
 --   * "Unison.Sqlite.Connection" provides an interface in @IO@, which takes the 'Connection' argument as an explicit
 --     argument.
---   * "Unison.Sqlite.DB" provides a type class interface, which moves the 'Connection' to an implicit argument. This
---     interface is also re-exported by this module, for convenient backwards compatibility with the existing queries.
---   * "Unison.Sqlite.Transaction" provides a newer, yet-unused interface that executes queries in transactions, with
---     automatic retries on @SQLITE_BUSY@ due to concurrent writers.
+--   * "Unison.Sqlite.Transaction" provides a safer interface that executes queries in transactions, with automatic
+--     retries on @SQLITE_BUSY@ due to concurrent writers.
 module Unison.Sqlite
   ( -- * Connection management
     Connection,
     withConnection,
 
-    -- * Type class query interface
-    DB,
-    runDB,
+    -- * Transaction interface
+    Transaction,
+    runTransaction,
+    savepoint,
 
     -- * Executing queries
     Sql (..),
@@ -77,7 +76,6 @@ module Unison.Sqlite
     trySetJournalMode,
 
     -- ** Low-level
-    withSavepoint,
     withStatement,
 
     -- * Exceptions
@@ -114,7 +112,6 @@ import Unison.Sqlite.Connection
     withConnection,
     withStatement,
   )
-import Unison.Sqlite.DB
 import Unison.Sqlite.DataVersion (DataVersion (..), getDataVersion)
 import Unison.Sqlite.Exception
   ( SomeSqliteException (..),
@@ -126,6 +123,7 @@ import Unison.Sqlite.Exception
   )
 import Unison.Sqlite.JournalMode (JournalMode (..), SetJournalModeException (..), trySetJournalMode)
 import Unison.Sqlite.Sql (Sql (..))
+import Unison.Sqlite.Transaction
 
 -- $query-naming-convention
 --

lib/unison-sqlite/src/Unison/Sqlite/DB.hs

@@ -1,265 +0,0 @@
--- | A type class interface to SQLite.
-module Unison.Sqlite.DB
-  ( -- * Type-class
-    DB,
-    runDB,
-    runTransaction,
-
-    -- * Executing queries
-
-    -- ** Without results
-
-    -- *** With parameters
-    execute,
-    executeMany,
-
-    -- *** Without parameters
-    execute_,
-
-    -- ** With results
-
-    -- *** With parameters
-    queryListRow,
-    queryListCol,
-    queryMaybeRow,
-    queryMaybeCol,
-    queryOneRow,
-    queryOneCol,
-
-    -- **** With checks
-    queryListRowCheck,
-    queryListColCheck,
-    queryMaybeRowCheck,
-    queryMaybeColCheck,
-    queryOneRowCheck,
-    queryOneColCheck,
-
-    -- *** Without parameters
-    queryListRow_,
-    queryListCol_,
-    queryMaybeRow_,
-    queryMaybeCol_,
-    queryOneRow_,
-    queryOneCol_,
-
-    -- **** With checks
-    queryListRowCheck_,
-    queryListColCheck_,
-    queryMaybeRowCheck_,
-    queryMaybeColCheck_,
-    queryOneRowCheck_,
-    queryOneColCheck_,
-
-    -- * Low-level operations
-    withSavepoint,
-  )
-where
-
-import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
-import qualified Database.SQLite.Simple as Sqlite
-import qualified Database.SQLite.Simple.FromField as Sqlite
-import Unison.Prelude
-import Unison.Sqlite.Connection (Connection)
-import qualified Unison.Sqlite.Connection as Connection
-import Unison.Sqlite.Exception (SqliteExceptionReason)
-import Unison.Sqlite.Sql (Sql (..))
-import Unison.Sqlite.Transaction (Transaction)
-import qualified Unison.Sqlite.Transaction as Transaction
-
-type DB m =
-  (MonadIO m, MonadReader Connection m)
-
-runDB :: MonadIO m => Connection -> ReaderT Connection m a -> m a
-runDB conn action =
-  runReaderT action conn
-
-runTransaction :: DB m => Transaction a -> m a
-runTransaction transaction = do
-  conn <- ask
-  Transaction.runTransaction conn transaction
-
--- Without results, with parameters
-
-execute :: (DB m, Sqlite.ToRow a) => Sql -> a -> m ()
-execute s params = do
-  conn <- ask
-  liftIO (Connection.execute conn s params)
-
-executeMany :: (DB m, Sqlite.ToRow a) => Sql -> [a] -> m ()
-executeMany s params = do
-  conn <- ask
-  liftIO (Connection.executeMany conn s params)
-
--- Without results, without parameters
-
-execute_ :: DB m => Sql -> m ()
-execute_ s = do
-  conn <- ask
-  liftIO (Connection.execute_ conn s)
-
--- With results, with parameters, without checks
-
-queryListRow :: (DB m, Sqlite.FromRow a, Sqlite.ToRow b) => Sql -> b -> m [a]
-queryListRow s params = do
-  conn <- ask
-  liftIO (Connection.queryListRow conn s params)
-
-queryListCol :: (DB m, Sqlite.FromField a, Sqlite.ToRow b) => Sql -> b -> m [a]
-queryListCol s params = do
-  conn <- ask
-  liftIO (Connection.queryListCol conn s params)
-
-queryMaybeRow :: (DB m, Sqlite.FromRow a, Sqlite.ToRow b) => Sql -> b -> m (Maybe a)
-queryMaybeRow s params = do
-  conn <- ask
-  liftIO (Connection.queryMaybeRow conn s params)
-
-queryMaybeCol :: (DB m, Sqlite.FromField a, Sqlite.ToRow b) => Sql -> b -> m (Maybe a)
-queryMaybeCol s params = do
-  conn <- ask
-  liftIO (Connection.queryMaybeCol conn s params)
-
-queryOneRow :: (DB m, Sqlite.FromRow b, Sqlite.ToRow a) => Sql -> a -> m b
-queryOneRow s params = do
-  conn <- ask
-  liftIO (Connection.queryOneRow conn s params)
-
-queryOneCol :: (DB m, Sqlite.FromField b, Sqlite.ToRow a) => Sql -> a -> m b
-queryOneCol s params = do
-  conn <- ask
-  liftIO (Connection.queryOneCol conn s params)
-
--- With results, with parameters, with checks
-
-queryListRowCheck ::
-  (DB m, Sqlite.FromRow b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  ([b] -> Either e r) ->
-  m r
-queryListRowCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryListRowCheck conn s params check)
-
-queryListColCheck ::
-  (DB m, Sqlite.FromField b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  ([b] -> Either e r) ->
-  m r
-queryListColCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryListColCheck conn s params check)
-
-queryMaybeRowCheck ::
-  (DB m, Sqlite.FromRow b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  (b -> Either e r) ->
-  m (Maybe r)
-queryMaybeRowCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryMaybeRowCheck conn s params check)
-
-queryMaybeColCheck ::
-  (DB m, Sqlite.FromField b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  (b -> Either e r) ->
-  m (Maybe r)
-queryMaybeColCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryMaybeColCheck conn s params check)
-
-queryOneRowCheck ::
-  (DB m, Sqlite.FromRow b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  (b -> Either e r) ->
-  m r
-queryOneRowCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryOneRowCheck conn s params check)
-
-queryOneColCheck ::
-  (DB m, Sqlite.FromField b, Sqlite.ToRow a, SqliteExceptionReason e) =>
-  Sql ->
-  a ->
-  (b -> Either e r) ->
-  m r
-queryOneColCheck s params check = do
-  conn <- ask
-  liftIO (Connection.queryOneColCheck conn s params check)
-
--- With results, without parameters, without checks
-
-queryListRow_ :: (DB m, Sqlite.FromRow a) => Sql -> m [a]
-queryListRow_ s = do
-  conn <- ask
-  liftIO (Connection.queryListRow_ conn s)
-
-queryListCol_ :: (DB m, Sqlite.FromField a) => Sql -> m [a]
-queryListCol_ s = do
-  conn <- ask
-  liftIO (Connection.queryListCol_ conn s)
-
-queryMaybeRow_ :: (DB m, Sqlite.FromRow a) => Sql -> m (Maybe a)
-queryMaybeRow_ s = do
-  conn <- ask
-  liftIO (Connection.queryMaybeRow_ conn s)
-
-queryMaybeCol_ :: (DB m, Sqlite.FromField a) => Sql -> m (Maybe a)
-queryMaybeCol_ s = do
-  conn <- ask
-  liftIO (Connection.queryMaybeCol_ conn s)
-
-queryOneRow_ :: (DB m, Sqlite.FromRow a) => Sql -> m a
-queryOneRow_ s = do
-  conn <- ask
-  liftIO (Connection.queryOneRow_ conn s)
-
-queryOneCol_ :: (DB m, Sqlite.FromField a) => Sql -> m a
-queryOneCol_ s = do
-  conn <- ask
-  liftIO (Connection.queryOneCol_ conn s)
-
--- With results, without parameters, with checks
-
-queryListRowCheck_ :: (DB m, Sqlite.FromRow a, SqliteExceptionReason e) => Sql -> ([a] -> Either e r) -> m r
-queryListRowCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryListRowCheck_ conn s check)
-
-queryListColCheck_ :: (DB m, Sqlite.FromField a, SqliteExceptionReason e) => Sql -> ([a] -> Either e r) -> m r
-queryListColCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryListColCheck_ conn s check)
-
-queryMaybeRowCheck_ :: (DB m, Sqlite.FromRow a, SqliteExceptionReason e) => Sql -> (a -> Either e r) -> m (Maybe r)
-queryMaybeRowCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryMaybeRowCheck_ conn s check)
-
-queryMaybeColCheck_ :: (DB m, Sqlite.FromField a, SqliteExceptionReason e) => Sql -> (a -> Either e r) -> m (Maybe r)
-queryMaybeColCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryMaybeColCheck_ conn s check)
-
-queryOneRowCheck_ :: (DB m, Sqlite.FromRow a, SqliteExceptionReason e) => Sql -> (a -> Either e r) -> m r
-queryOneRowCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryOneRowCheck_ conn s check)
-
-queryOneColCheck_ :: (DB m, Sqlite.FromField a, SqliteExceptionReason e) => Sql -> (a -> Either e r) -> m r
-queryOneColCheck_ s check = do
-  conn <- ask
-  liftIO (Connection.queryOneColCheck_ conn s check)
-
--- Low-level
-
--- | Perform an action within a named savepoint. The action is provided a rollback action.
-withSavepoint :: (DB m, MonadUnliftIO m) => Text -> (m () -> m a) -> m a
-withSavepoint name action = do
-  conn <- ask
-  withRunInIO \unlift ->
-    liftIO (Connection.withSavepointIO conn name (unlift . action . liftIO))

lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs

@@ -2,6 +2,7 @@ module Unison.Sqlite.Transaction
   ( -- * Transaction management
     Transaction,
     runTransaction,
+    savepoint,
 
     -- * Executing queries
 
@@ -53,14 +54,16 @@ where
 import Control.Concurrent (threadDelay)
 import Control.Exception (Exception (fromException), onException, throwIO)
 import Control.Monad.Trans.Reader (ReaderT (..))
+import qualified Data.Text as Text
 import qualified Database.SQLite.Simple as Sqlite
 import qualified Database.SQLite.Simple.FromField as Sqlite
-import Unison.Prelude hiding (try)
+import qualified System.Random as Random
+import Unison.Prelude
 import Unison.Sqlite.Connection (Connection (..))
 import qualified Unison.Sqlite.Connection as Connection
 import Unison.Sqlite.Exception (SqliteExceptionReason, SqliteQueryException, pattern SqliteBusyException)
 import Unison.Sqlite.Sql
-import UnliftIO.Exception (catchAny, try, trySyncOrAsync, uninterruptibleMask)
+import UnliftIO.Exception (catchAny, trySyncOrAsync, uninterruptibleMask)
 
 newtype Transaction a
   = Transaction (Connection -> IO a)
@@ -100,6 +103,20 @@ runTransaction conn (Transaction f) = liftIO do
     ignoringExceptions action =
       action `catchAny` \_ -> pure ()
 
+savepoint :: Transaction (Either a a) -> Transaction a
+savepoint (Transaction action) = do
+  Transaction \conn -> do
+    -- Generate a random name for the savepoint, so the caller isn't burdened with coming up with a name. Seems
+    -- extremely unlikely for this to go wrong (i.e. some super nested withSavepoint call that ends up generating the
+    -- same savepoint name twice in a single scope).
+    name <- Text.pack <$> replicateM 10 (Random.randomRIO ('a', 'z'))
+    Connection.withSavepointIO conn name \rollback ->
+      action conn >>= \case
+        Left result -> do
+          rollback
+          pure result
+        Right result -> pure result
+
 -- Without results, with parameters
 
 execute :: Sqlite.ToRow a => Sql -> a -> Transaction ()

lib/unison-sqlite/unison-sqlite.cabal

@@ -20,7 +20,6 @@ library
       Unison.Sqlite
       Unison.Sqlite.Connection
       Unison.Sqlite.Connection.Internal
-      Unison.Sqlite.DB
       Unison.Sqlite.Transaction
   other-modules:
       Unison.Sqlite.DataVersion
@@ -59,6 +58,7 @@ library
     , direct-sqlite
     , exceptions
     , mtl
+    , random
     , recover-rtti
     , sqlite-simple
     , text