Internal.hs

{-# language DerivingVia #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}

module Database.Sqlite.Easy.Internal where

import Database.SQLite3
import Data.String (IsString)
import Data.Text (Text)
import Control.Exception
import Data.Typeable
import Data.Pool

-- * Connection

-- | A SQLite3 connection string
newtype ConnectionString
  = ConnectionString
    { unConnectionString :: Text
    }
  deriving IsString via Text
  deriving Show

-- | Create a pool of a sqlite3 db with a specific connection string.
createSqlitePool :: ConnectionString -> IO (Pool Database)
createSqlitePool (ConnectionString connStr) =
  newPool PoolConfig
    { createResource = open connStr
    , freeResource = close
    , poolCacheTTL = 180
    , poolMaxResources = 50
    }

-- | Open a database, run some stuff, close the database.
withDb :: ConnectionString -> (Database -> IO a) -> IO a
withDb (ConnectionString connStr) = bracket (open connStr) close

-- * Execution

-- | A SQL statement
newtype SQL
  = SQL
    { unSQL :: Text
    }
  deriving (Semigroup, IsString) via Text
  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 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

-- | Run a statement and fetch all of the data.
fetchAll :: Statement -> IO [[SQLData]]
fetchAll stmt = do
  res <- step stmt
  case res of
    Row -> do
      row <- columns stmt
      rows <- fetchAll stmt
      pure (row : rows)
    Done -> do
      finalize stmt
      pure []

-- * Transaction

-- | 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
    ]

asTransaction' :: Database -> IO a -> IO a
asTransaction' db action = do
  [] <- run "BEGIN" db
  catches
    (action <* run "COMMIT" db)
    [ Handler $ \(ex :: SomeException) -> run "ROLLBACK" db *> throwIO ex
    ]

-- | Cancel a transaction by supplying the return value.
--   To be used inside transactions.
cancelTransaction :: Typeable a => a -> IO a
cancelTransaction = throwIO . CancelTransaction

data CancelTransaction a
  = CancelTransaction a

instance Show (CancelTransaction a) where
  show CancelTransaction{} = "CancelTransaction"

instance (Typeable a) => Exception (CancelTransaction a)