{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Unison.Sqlite.Connection
  ( -- * Connection management
    Connection (..),
    withConnection,

    -- * Executing queries

    -- ** Without results
    execute,
    executeStatements,

    -- ** With results
    queryStreamRow,
    queryStreamCol,
    queryListRow,
    queryListCol,
    queryMaybeRow,
    queryMaybeCol,
    queryOneRow,
    queryOneCol,

    -- *** With checks
    queryListRowCheck,
    queryListColCheck,
    queryMaybeRowCheck,
    queryMaybeColCheck,
    queryOneRowCheck,
    queryOneColCheck,

    -- * Rows modified
    rowsModified,

    -- * Vacuum (into)
    vacuum,
    vacuumInto,

    -- * Low-level operations

    -- ** Transaction
    begin,
    beginImmediate,
    commit,
    rollback,

    -- ** Savepoint
    withSavepoint,
    withSavepointIO,
    savepoint,
    rollbackTo,
    release,

    -- * Exceptions
    ExpectedAtMostOneRowException (..),
    ExpectedExactlyOneRowException (..),
  )
where

import Database.SQLite.Simple qualified as Sqlite
import Database.SQLite.Simple.FromField qualified as Sqlite
import Database.SQLite3 qualified as Direct.Sqlite
import Debug.Pretty.Simple (pTraceShowM)
import Debug.RecoverRTTI (anythingToString)
import GHC.Stack (currentCallStack)
import System.Environment qualified as Env
import Unison.Debug qualified as Debug
import Unison.Prelude
import Unison.Sqlite.Connection.Internal (Connection (..))
import Unison.Sqlite.Exception
import Unison.Sqlite.Sql (Sql (..))
import Unison.Sqlite.Sql qualified as Sql
import UnliftIO.Exception

-- | Perform an action with a connection to a SQLite database.
--
-- Note: the connection is created with @PRAGMA foreign_keys = ON@ automatically, to work around the fact that SQLite
-- does not automatically enforce foreign key integrity, because it elected to maintain backwards compatibility with
-- code that was written before the foreign key integrity feature was implemented.
withConnection ::
  (MonadUnliftIO m) =>
  -- | Connection name, for debugging.
  String ->
  -- | Path to SQLite database file.
  FilePath ->
  (Connection -> m a) ->
  m a
withConnection :: forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> FilePath -> (Connection -> m a) -> m a
withConnection FilePath
name FilePath
file =
  m Connection -> (Connection -> m ()) -> (Connection -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO Connection
openConnection FilePath
name FilePath
file)) (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
closeConnection)

-- Open a connection to a SQLite database.
openConnection ::
  -- Connection name, for debugging.
  String ->
  -- Path to SQLite database file.
  FilePath ->
  IO Connection
openConnection :: FilePath -> FilePath -> IO Connection
openConnection FilePath
name FilePath
file = do
  FilePath
sqliteURI <-
    FilePath -> IO (Maybe FilePath)
Env.lookupEnv FilePath
"UNISON_READONLY" IO (Maybe FilePath) -> (Maybe FilePath -> FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe FilePath
Nothing -> FilePath
file
      Just FilePath
"" -> FilePath
file
      Maybe FilePath
_ -> FilePath
"file:" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"?mode=ro"
  Connection
conn0 <- FilePath -> IO Connection
Sqlite.open FilePath
sqliteURI IO Connection -> (SQLError -> IO Connection) -> IO Connection
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` FilePath -> FilePath -> SQLError -> IO Connection
forall a. FilePath -> FilePath -> SQLError -> IO a
rethrowAsSqliteConnectException FilePath
name FilePath
file
  let conn :: Connection
conn = Connection {$sel:conn:Connection :: Connection
conn = Connection
conn0, FilePath
file :: FilePath
$sel:file:Connection :: FilePath
file, FilePath
name :: FilePath
$sel:name:Connection :: FilePath
name}
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| PRAGMA foreign_keys = ON |]
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| PRAGMA busy_timeout = 60000 |]
  Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn

-- Close a connection opened with 'openConnection'.
closeConnection :: Connection -> IO ()
closeConnection :: Connection -> IO ()
closeConnection (Connection FilePath
_ FilePath
_ Connection
conn) =
  -- FIXME if this throws an exception, it won't be under `SomeSqliteException`
  -- Possible fixes:
  --   1. Add close exception to the hierarchy, e.g. `SqliteCloseException`
  --   2. Always ignore exceptions thrown by `close` (Mitchell prefers this one)
  Connection -> IO ()
Sqlite.close Connection
conn

-- An internal type, for making prettier debug logs

data Query = Query
  { Query -> Text
sql :: Text,
    Query -> [SQLData]
params :: [Sqlite.SQLData],
    Query -> Maybe FilePath
result :: Maybe String,
    Query -> [FilePath]
callStack :: [String]
  }

instance Show Query where
  show :: Query -> FilePath
show Query {Text
$sel:sql:Query :: Query -> Text
sql :: Text
sql, [SQLData]
$sel:params:Query :: Query -> [SQLData]
params :: [SQLData]
params, Maybe FilePath
$sel:result:Query :: Query -> Maybe FilePath
result :: Maybe FilePath
result, [FilePath]
$sel:callStack:Query :: Query -> [FilePath]
callStack :: [FilePath]
callStack} =
    [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ FilePath
"Query { sql = ",
        Text -> FilePath
forall a. Show a => a -> FilePath
show Text
sql,
        if [SQLData] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SQLData]
params then FilePath
"" else FilePath
", params = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [SQLData] -> FilePath
forall a. Show a => a -> FilePath
show [SQLData]
params,
        FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\FilePath
r -> FilePath
", results = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
r) Maybe FilePath
result,
        if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
callStack then FilePath
"" else FilePath
", callStack = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
callStack,
        FilePath
" }"
      ]

logQuery :: Sql -> Maybe a -> IO ()
logQuery :: forall a. Sql -> Maybe a -> IO ()
logQuery (Sql Text
sql [SQLData]
params) Maybe a
result =
  DebugFlag -> IO () -> IO ()
forall (m :: * -> *). Monad m => DebugFlag -> m () -> m ()
Debug.whenDebug DebugFlag
Debug.Sqlite do
    [FilePath]
callStack <- IO [FilePath]
currentCallStack
    Query -> IO ()
forall a (f :: * -> *). (Show a, Applicative f) => a -> f ()
pTraceShowM
      Query
        { Text
$sel:sql:Query :: Text
sql :: Text
sql,
          [SQLData]
$sel:params:Query :: [SQLData]
params :: [SQLData]
params,
          $sel:result:Query :: Maybe FilePath
result = a -> FilePath
forall a. a -> FilePath
anythingToString (a -> FilePath) -> Maybe a -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
result,
          [FilePath]
$sel:callStack:Query :: [FilePath]
callStack :: [FilePath]
callStack
        }

-- Without results

execute :: (HasCallStack) => Connection -> Sql -> IO ()
execute :: HasCallStack => Connection -> Sql -> IO ()
execute conn :: Connection
conn@(Connection FilePath
_ FilePath
_ Connection
conn0) sql :: Sql
sql@(Sql Text
s [SQLData]
params) = do
  Sql -> Maybe Any -> IO ()
forall a. Sql -> Maybe a -> IO ()
logQuery Sql
sql Maybe Any
forall a. Maybe a
Nothing
  IO ()
doExecute IO () -> (SQLError -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SQLError
exception :: Sqlite.SQLError) ->
    SqliteQueryExceptionInfo -> IO ()
forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException
      SqliteQueryExceptionInfo
        { $sel:connection:SqliteQueryExceptionInfo :: Connection
connection = Connection
conn,
          $sel:exception:SqliteQueryExceptionInfo :: SomeSqliteExceptionReason
exception = SQLError -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason SQLError
exception,
          Sql
sql :: Sql
$sel:sql:SqliteQueryExceptionInfo :: Sql
sql
        }
  where
    doExecute :: IO ()
    doExecute :: IO ()
doExecute =
      Connection -> Query -> (Statement -> IO ()) -> IO ()
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
Sqlite.withStatement Connection
conn0 (Text -> Query
forall a b. Coercible a b => a -> b
coerce Text
s) \(Sqlite.Statement Statement
statement) -> do
        Statement -> [SQLData] -> IO ()
bindParameters Statement
statement [SQLData]
params
        IO StepResult -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Statement -> IO StepResult
Direct.Sqlite.step Statement
statement)

-- | Execute one or more semicolon-delimited statements.
--
-- This function does not support parameters, and is mostly useful for executing DDL and migrations.
executeStatements :: (HasCallStack) => Connection -> Text -> IO ()
executeStatements :: HasCallStack => Connection -> Text -> IO ()
executeStatements conn :: Connection
conn@(Connection FilePath
_ FilePath
_ (Sqlite.Connection Database
database IORef Word64
_tempNameCounter)) Text
sql = do
  Sql -> Maybe Any -> IO ()
forall a. Sql -> Maybe a -> IO ()
logQuery (Text -> [SQLData] -> Sql
Sql Text
sql []) Maybe Any
forall a. Maybe a
Nothing
  Database -> Text -> IO ()
Direct.Sqlite.exec Database
database Text
sql IO () -> (SQLError -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SQLError
exception :: Sqlite.SQLError) ->
    SqliteQueryExceptionInfo -> IO ()
forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException
      SqliteQueryExceptionInfo
        { $sel:connection:SqliteQueryExceptionInfo :: Connection
connection = Connection
conn,
          $sel:exception:SqliteQueryExceptionInfo :: SomeSqliteExceptionReason
exception = SQLError -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason SQLError
exception,
          $sel:sql:SqliteQueryExceptionInfo :: Sql
sql = Text -> [SQLData] -> Sql
Sql Text
sql []
        }

-- With results, without checks

queryStreamRow :: (HasCallStack, Sqlite.FromRow a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
queryStreamRow :: forall a r.
(HasCallStack, FromRow a) =>
Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
queryStreamRow conn :: Connection
conn@(Connection FilePath
_ FilePath
_ Connection
conn0) sql :: Sql
sql@(Sql Text
s [SQLData]
params) IO (Maybe a) -> IO r
callback =
  IO r
run IO r -> (SQLError -> IO r) -> IO r
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SQLError
exception :: Sqlite.SQLError) ->
    SqliteQueryExceptionInfo -> IO r
forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException
      SqliteQueryExceptionInfo
        { $sel:connection:SqliteQueryExceptionInfo :: Connection
connection = Connection
conn,
          $sel:exception:SqliteQueryExceptionInfo :: SomeSqliteExceptionReason
exception = SQLError -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason SQLError
exception,
          Sql
$sel:sql:SqliteQueryExceptionInfo :: Sql
sql :: Sql
sql
        }
  where
    run :: IO r
run =
      IO Statement -> (Statement -> IO ()) -> (Statement -> IO r) -> IO r
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Connection -> Query -> IO Statement
Sqlite.openStatement Connection
conn0 (Text -> Query
forall a b. Coercible a b => a -> b
coerce Text
s)) Statement -> IO ()
Sqlite.closeStatement \Statement
statement -> do
        Statement -> [SQLData] -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
Sqlite.bind Statement
statement [SQLData]
params
        IO (Maybe a) -> IO r
callback (Statement -> IO (Maybe a)
forall r. FromRow r => Statement -> IO (Maybe r)
Sqlite.nextRow Statement
statement)

queryStreamCol ::
  forall a r.
  (HasCallStack, Sqlite.FromField a) =>
  Connection ->
  Sql ->
  (IO (Maybe a) -> IO r) ->
  IO r
queryStreamCol :: forall a r.
(HasCallStack, FromField a) =>
Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
queryStreamCol =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce
    @(Connection -> Sql -> (IO (Maybe (Sqlite.Only a)) -> IO r) -> IO r)
    @(Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r)
    Connection -> Sql -> (IO (Maybe (Only a)) -> IO r) -> IO r
forall a r.
(HasCallStack, FromRow a) =>
Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
queryStreamRow

queryListRow :: forall a. (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
queryListRow :: forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
queryListRow conn :: Connection
conn@(Connection FilePath
_ FilePath
_ Connection
conn0) sql :: Sql
sql@(Sql Text
s [SQLData]
params) = do
  [a]
result <-
    IO [a]
doQuery
      IO [a] -> (SQLError -> IO [a]) -> IO [a]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SQLError
exception :: Sqlite.SQLError) ->
        SqliteQueryExceptionInfo -> IO [a]
forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException
          SqliteQueryExceptionInfo
            { $sel:connection:SqliteQueryExceptionInfo :: Connection
connection = Connection
conn,
              $sel:exception:SqliteQueryExceptionInfo :: SomeSqliteExceptionReason
exception = SQLError -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason SQLError
exception,
              Sql
$sel:sql:SqliteQueryExceptionInfo :: Sql
sql :: Sql
sql
            }
  Sql -> Maybe [a] -> IO ()
forall a. Sql -> Maybe a -> IO ()
logQuery Sql
sql ([a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
result)
  [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
result
  where
    doQuery :: IO [a]
    doQuery :: IO [a]
doQuery =
      Connection -> Query -> (Statement -> IO [a]) -> IO [a]
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
Sqlite.withStatement Connection
conn0 (Text -> Query
forall a b. Coercible a b => a -> b
coerce Text
s) \Statement
statement -> do
        Statement -> [SQLData] -> IO ()
bindParameters (Statement -> Statement
forall a b. Coercible a b => a -> b
coerce Statement
statement) [SQLData]
params
        let loop :: [a] -> IO [a]
            loop :: [a] -> IO [a]
loop [a]
rows =
              Statement -> IO (Maybe a)
forall r. FromRow r => Statement -> IO (Maybe r)
Sqlite.nextRow Statement
statement IO (Maybe a) -> (Maybe a -> IO [a]) -> IO [a]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe a
Nothing -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rows)
                Just a
row -> [a] -> IO [a]
loop (a
row a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rows)
        [a] -> IO [a]
loop []

queryListCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO [a]
queryListCol :: forall a.
(FromField a, HasCallStack) =>
Connection -> Sql -> IO [a]
queryListCol =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Connection -> Sql -> IO [Sqlite.Only a]) @(Connection -> Sql -> IO [a]) Connection -> Sql -> IO [Only a]
forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
queryListRow

queryMaybeRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO (Maybe a)
queryMaybeRow :: forall a.
(FromRow a, HasCallStack) =>
Connection -> Sql -> IO (Maybe a)
queryMaybeRow Connection
conn Sql
s =
  Connection
-> Sql
-> ([a] -> Either ExpectedAtMostOneRowException (Maybe a))
-> IO (Maybe a)
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
queryListRowCheck Connection
conn Sql
s \case
    [] -> Maybe a -> Either ExpectedAtMostOneRowException (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    [a
x] -> Maybe a -> Either ExpectedAtMostOneRowException (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
    [a]
xs -> ExpectedAtMostOneRowException
-> Either ExpectedAtMostOneRowException (Maybe a)
forall a b. a -> Either a b
Left (FilePath -> ExpectedAtMostOneRowException
ExpectedAtMostOneRowException ([a] -> FilePath
forall a. a -> FilePath
anythingToString [a]
xs))

queryMaybeCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO (Maybe a)
queryMaybeCol :: forall a.
(FromField a, HasCallStack) =>
Connection -> Sql -> IO (Maybe a)
queryMaybeCol Connection
conn Sql
s =
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO (Maybe (Sqlite.Only a))) @(IO (Maybe a)) (Connection -> Sql -> IO (Maybe (Only a))
forall a.
(FromRow a, HasCallStack) =>
Connection -> Sql -> IO (Maybe a)
queryMaybeRow Connection
conn Sql
s)

queryOneRow :: (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO a
queryOneRow :: forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO a
queryOneRow Connection
conn Sql
s =
  Connection
-> Sql -> ([a] -> Either ExpectedExactlyOneRowException a) -> IO a
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
queryListRowCheck Connection
conn Sql
s \case
    [a
x] -> a -> Either ExpectedExactlyOneRowException a
forall a b. b -> Either a b
Right a
x
    [a]
xs -> ExpectedExactlyOneRowException
-> Either ExpectedExactlyOneRowException a
forall a b. a -> Either a b
Left (FilePath -> ExpectedExactlyOneRowException
ExpectedExactlyOneRowException ([a] -> FilePath
forall a. a -> FilePath
anythingToString [a]
xs))

queryOneCol :: forall a. (Sqlite.FromField a, HasCallStack) => Connection -> Sql -> IO a
queryOneCol :: forall a. (FromField a, HasCallStack) => Connection -> Sql -> IO a
queryOneCol Connection
conn Sql
s = do
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO (Sqlite.Only a)) @(IO a) (Connection -> Sql -> IO (Only a)
forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO a
queryOneRow Connection
conn Sql
s)

-- With results, with checks

queryListRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  ([a] -> Either e r) ->
  IO r
queryListRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
queryListRowCheck Connection
conn Sql
s [a] -> Either e r
check =
  Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
forall a r.
(FromRow a, HasCallStack) =>
Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
gqueryListCheck Connection
conn Sql
s ((e -> SomeSqliteExceptionReason)
-> Either e r -> Either SomeSqliteExceptionReason r
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft e -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason (Either e r -> Either SomeSqliteExceptionReason r)
-> ([a] -> Either e r) -> [a] -> Either SomeSqliteExceptionReason r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Either e r
check)

gqueryListCheck ::
  (Sqlite.FromRow a, HasCallStack) =>
  Connection ->
  Sql ->
  ([a] -> Either SomeSqliteExceptionReason r) ->
  IO r
gqueryListCheck :: forall a r.
(FromRow a, HasCallStack) =>
Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
gqueryListCheck Connection
conn Sql
sql [a] -> Either SomeSqliteExceptionReason r
check = do
  [a]
xs <- Connection -> Sql -> IO [a]
forall a. (FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
queryListRow Connection
conn Sql
sql
  case [a] -> Either SomeSqliteExceptionReason r
check [a]
xs of
    Left SomeSqliteExceptionReason
exception ->
      SqliteQueryExceptionInfo -> IO r
forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException
        SqliteQueryExceptionInfo
          { $sel:connection:SqliteQueryExceptionInfo :: Connection
connection = Connection
conn,
            SomeSqliteExceptionReason
$sel:exception:SqliteQueryExceptionInfo :: SomeSqliteExceptionReason
exception :: SomeSqliteExceptionReason
exception,
            Sql
$sel:sql:SqliteQueryExceptionInfo :: Sql
sql :: Sql
sql
          }
    Right r
result -> r -> IO r
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
result

queryListColCheck ::
  forall a e r.
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  ([a] -> Either e r) ->
  IO r
queryListColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
queryListColCheck Connection
conn Sql
s [a] -> Either e r
check =
  Connection -> Sql -> ([Only a] -> Either e r) -> IO r
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> ([a] -> Either e r) -> IO r
queryListRowCheck Connection
conn Sql
s (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @([a] -> Either e r) @([Sqlite.Only a] -> Either e r) [a] -> Either e r
check)

queryMaybeRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  (a -> Either e r) ->
  IO (Maybe r)
queryMaybeRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
queryMaybeRowCheck Connection
conn Sql
s a -> Either e r
check =
  Connection
-> Sql
-> ([a] -> Either SomeSqliteExceptionReason (Maybe r))
-> IO (Maybe r)
forall a r.
(FromRow a, HasCallStack) =>
Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
gqueryListCheck Connection
conn Sql
s \case
    [] -> Maybe r -> Either SomeSqliteExceptionReason (Maybe r)
forall a. a -> Either SomeSqliteExceptionReason a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe r
forall a. Maybe a
Nothing
    [a
x] -> (e -> SomeSqliteExceptionReason)
-> (r -> Maybe r)
-> Either e r
-> Either SomeSqliteExceptionReason (Maybe r)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason r -> Maybe r
forall a. a -> Maybe a
Just (a -> Either e r
check a
x)
    [a]
xs -> SomeSqliteExceptionReason
-> Either SomeSqliteExceptionReason (Maybe r)
forall a b. a -> Either a b
Left (ExpectedAtMostOneRowException -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason (FilePath -> ExpectedAtMostOneRowException
ExpectedAtMostOneRowException ([a] -> FilePath
forall a. a -> FilePath
anythingToString [a]
xs)))

queryMaybeColCheck ::
  forall a e r.
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  (a -> Either e r) ->
  IO (Maybe r)
queryMaybeColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
queryMaybeColCheck Connection
conn Sql
s a -> Either e r
check =
  Connection -> Sql -> (Only a -> Either e r) -> IO (Maybe r)
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO (Maybe r)
queryMaybeRowCheck Connection
conn Sql
s (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(a -> Either e r) @(Sqlite.Only a -> Either e r) a -> Either e r
check)

queryOneRowCheck ::
  (Sqlite.FromRow a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  (a -> Either e r) ->
  IO r
queryOneRowCheck :: forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO r
queryOneRowCheck Connection
conn Sql
s a -> Either e r
check =
  Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
forall a r.
(FromRow a, HasCallStack) =>
Connection
-> Sql -> ([a] -> Either SomeSqliteExceptionReason r) -> IO r
gqueryListCheck Connection
conn Sql
s \case
    [a
x] -> (e -> SomeSqliteExceptionReason)
-> Either e r -> Either SomeSqliteExceptionReason r
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft e -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason (a -> Either e r
check a
x)
    [a]
xs -> SomeSqliteExceptionReason -> Either SomeSqliteExceptionReason r
forall a b. a -> Either a b
Left (ExpectedExactlyOneRowException -> SomeSqliteExceptionReason
forall e. SqliteExceptionReason e => e -> SomeSqliteExceptionReason
SomeSqliteExceptionReason (FilePath -> ExpectedExactlyOneRowException
ExpectedExactlyOneRowException ([a] -> FilePath
forall a. a -> FilePath
anythingToString [a]
xs)))

queryOneColCheck ::
  forall a e r.
  (Sqlite.FromField a, SqliteExceptionReason e, HasCallStack) =>
  Connection ->
  Sql ->
  (a -> Either e r) ->
  IO r
queryOneColCheck :: forall a e r.
(FromField a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO r
queryOneColCheck Connection
conn Sql
s a -> Either e r
check =
  Connection -> Sql -> (Only a -> Either e r) -> IO r
forall a e r.
(FromRow a, SqliteExceptionReason e, HasCallStack) =>
Connection -> Sql -> (a -> Either e r) -> IO r
queryOneRowCheck Connection
conn Sql
s (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(a -> Either e r) @(Sqlite.Only a -> Either e r) a -> Either e r
check)

-- Rows modified

rowsModified :: Connection -> IO Int
rowsModified :: Connection -> IO Int
rowsModified (Connection FilePath
_ FilePath
_ Connection
conn) =
  Connection -> IO Int
Sqlite.changes Connection
conn

-- Vacuum

-- | @VACUUM@, and return whether or not the vacuum succeeded. A vacuum fails if the connection has any open
-- transactions.
vacuum :: Connection -> IO Bool
vacuum :: Connection -> IO Bool
vacuum Connection
conn =
  IO () -> IO (Either SqliteQueryException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| VACUUM |]) IO (Either SqliteQueryException ())
-> (Either SqliteQueryException () -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left SqliteQueryException
SqliteBusyException -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Left SqliteQueryException
exception -> SqliteQueryException -> IO Bool
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SqliteQueryException
exception
    Right () -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | @VACUUM INTO@
vacuumInto :: Connection -> FilePath -> IO ()
vacuumInto :: Connection -> FilePath -> IO ()
vacuumInto Connection
conn FilePath
file =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| VACUUM INTO :file |]

-- Low-level

-- | @BEGIN@
begin :: Connection -> IO ()
begin :: Connection -> IO ()
begin Connection
conn =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| BEGIN |]

-- | @BEGIN IMMEDIATE@
beginImmediate :: Connection -> IO ()
beginImmediate :: Connection -> IO ()
beginImmediate Connection
conn =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| BEGIN IMMEDIATE |]

-- | @COMMIT@
commit :: Connection -> IO ()
commit :: Connection -> IO ()
commit Connection
conn =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| COMMIT |]

-- | @ROLLBACK@
rollback :: Connection -> IO ()
rollback :: Connection -> IO ()
rollback Connection
conn =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn [Sql.sql| ROLLBACK |]

-- | Perform an action within a named savepoint. The action is provided a rollback action.
withSavepoint :: (MonadUnliftIO m) => Connection -> Text -> (m () -> m a) -> m a
withSavepoint :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Text -> (m () -> m a) -> m a
withSavepoint Connection
conn Text
name m () -> m a
action =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
runInIO ->
    Connection -> Text -> (IO () -> IO a) -> IO a
forall a. Connection -> Text -> (IO () -> IO a) -> IO a
withSavepointIO Connection
conn Text
name \IO ()
rollback ->
      m a -> IO a
forall a. m a -> IO a
runInIO (m () -> m a
action (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
rollback))

withSavepointIO :: Connection -> Text -> (IO () -> IO a) -> IO a
withSavepointIO :: forall a. Connection -> Text -> (IO () -> IO a) -> IO a
withSavepointIO Connection
conn Text
name IO () -> IO a
action = do
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask \forall a. IO a -> IO a
restore -> do
    Connection -> Text -> IO ()
savepoint Connection
conn Text
name
    a
result <-
      IO a -> IO a
forall a. IO a -> IO a
restore (IO () -> IO a
action IO ()
doRollbackTo) IO a -> IO () -> IO a
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`onException` do
        IO ()
doRollbackTo
        IO ()
doRelease
    IO ()
doRelease
    a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
  where
    doRollbackTo :: IO ()
doRollbackTo = Connection -> Text -> IO ()
rollbackTo Connection
conn Text
name
    doRelease :: IO ()
doRelease = Connection -> Text -> IO ()
release Connection
conn Text
name

-- | @SAVEPOINT@
savepoint :: Connection -> Text -> IO ()
savepoint :: Connection -> Text -> IO ()
savepoint Connection
conn Text
name =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn (Text -> [SQLData] -> Sql
Sql (Text
"SAVEPOINT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [])

-- | @ROLLBACK TO@
rollbackTo :: Connection -> Text -> IO ()
rollbackTo :: Connection -> Text -> IO ()
rollbackTo Connection
conn Text
name =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn (Text -> [SQLData] -> Sql
Sql (Text
"ROLLBACK TO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [])

-- | @RELEASE@
release :: Connection -> Text -> IO ()
release :: Connection -> Text -> IO ()
release Connection
conn Text
name =
  HasCallStack => Connection -> Sql -> IO ()
Connection -> Sql -> IO ()
execute Connection
conn (Text -> [SQLData] -> Sql
Sql (Text
"RELEASE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [])

-----------------------------------------------------------------------------------------------------------------------
-- Utils

bindParameters :: Direct.Sqlite.Statement -> [Sqlite.SQLData] -> IO ()
bindParameters :: Statement -> [SQLData] -> IO ()
bindParameters Statement
statement =
  ParamIndex -> [SQLData] -> IO ()
loop ParamIndex
1
  where
    loop :: Direct.Sqlite.ParamIndex -> [Sqlite.SQLData] -> IO ()
    loop :: ParamIndex -> [SQLData] -> IO ()
loop !ParamIndex
i = \case
      [] -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      SQLData
p : [SQLData]
ps -> do
        Statement -> ParamIndex -> SQLData -> IO ()
Direct.Sqlite.bindSQLData Statement
statement ParamIndex
i SQLData
p
        ParamIndex -> [SQLData] -> IO ()
loop (ParamIndex
i ParamIndex -> ParamIndex -> ParamIndex
forall a. Num a => a -> a -> a
+ ParamIndex
1) [SQLData]
ps

------------------------------------------------------------------------------------------------------------------------
-- Exceptions

-- | A query was expected to return exactly one row, but it did not. The exception carries a string representation of
-- the rows that were actually returned.
newtype ExpectedExactlyOneRowException = ExpectedExactlyOneRowException
  { ExpectedExactlyOneRowException -> FilePath
rows :: String
  }
  deriving stock (Int -> ExpectedExactlyOneRowException -> FilePath -> FilePath
[ExpectedExactlyOneRowException] -> FilePath -> FilePath
ExpectedExactlyOneRowException -> FilePath
(Int -> ExpectedExactlyOneRowException -> FilePath -> FilePath)
-> (ExpectedExactlyOneRowException -> FilePath)
-> ([ExpectedExactlyOneRowException] -> FilePath -> FilePath)
-> Show ExpectedExactlyOneRowException
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ExpectedExactlyOneRowException -> FilePath -> FilePath
showsPrec :: Int -> ExpectedExactlyOneRowException -> FilePath -> FilePath
$cshow :: ExpectedExactlyOneRowException -> FilePath
show :: ExpectedExactlyOneRowException -> FilePath
$cshowList :: [ExpectedExactlyOneRowException] -> FilePath -> FilePath
showList :: [ExpectedExactlyOneRowException] -> FilePath -> FilePath
Show)
  deriving anyclass (Show ExpectedExactlyOneRowException
Typeable ExpectedExactlyOneRowException
(Show ExpectedExactlyOneRowException,
 Typeable ExpectedExactlyOneRowException) =>
SqliteExceptionReason ExpectedExactlyOneRowException
forall e. (Show e, Typeable e) => SqliteExceptionReason e
SqliteExceptionReason)

-- | A query was expected to return exactly one row, but it did not. The exception carries a string representation of
-- the rows that were actually returned.
newtype ExpectedAtMostOneRowException = ExpectedAtMostOneRowException
  { ExpectedAtMostOneRowException -> FilePath
rows :: String
  }
  deriving stock (Int -> ExpectedAtMostOneRowException -> FilePath -> FilePath
[ExpectedAtMostOneRowException] -> FilePath -> FilePath
ExpectedAtMostOneRowException -> FilePath
(Int -> ExpectedAtMostOneRowException -> FilePath -> FilePath)
-> (ExpectedAtMostOneRowException -> FilePath)
-> ([ExpectedAtMostOneRowException] -> FilePath -> FilePath)
-> Show ExpectedAtMostOneRowException
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ExpectedAtMostOneRowException -> FilePath -> FilePath
showsPrec :: Int -> ExpectedAtMostOneRowException -> FilePath -> FilePath
$cshow :: ExpectedAtMostOneRowException -> FilePath
show :: ExpectedAtMostOneRowException -> FilePath
$cshowList :: [ExpectedAtMostOneRowException] -> FilePath -> FilePath
showList :: [ExpectedAtMostOneRowException] -> FilePath -> FilePath
Show)
  deriving anyclass (Show ExpectedAtMostOneRowException
Typeable ExpectedAtMostOneRowException
(Show ExpectedAtMostOneRowException,
 Typeable ExpectedAtMostOneRowException) =>
SqliteExceptionReason ExpectedAtMostOneRowException
forall e. (Show e, Typeable e) => SqliteExceptionReason e
SqliteExceptionReason)