<commit_before>module HighSQL.API where

import HighSQL.Prelude hiding (read, Read, write, Write)
import qualified Data.Pool as Pool
import qualified HighSQL.CompositionT as CompositionT
import qualified HighSQL.Backend as Backend
import qualified ListT


-- * Session
-------------------------

-- | 
-- A session, in which transactions are executed.
-- It maintains a shared state between transactions.
newtype S m r =
  S (ReaderT (Pool.Pool Backend.Connection) (EitherT SessionError m) r)
  deriving (Functor, Applicative, Monad, MonadIO)

-- |
-- Run the session monad transformer in the base monad.
session :: Backend.Backend -> S m r -> m r
session b s =
  $notImplemented


-- ** Error
-------------------------

data SessionError =
  TransactionError TransactionError


-- * Transaction
-------------------------

-- |
-- A transaction with a level @l@ and a result @r@.
newtype T l s r =
  T (ReaderT Backend.Connection (EitherT TransactionError IO) r)
  deriving (Functor, Applicative, Monad)

transaction :: MonadIO m => (forall s. T l s r) -> S m r
transaction t = 
  do
    pool <- S $ ask
    e <-
      liftIO $ Pool.withResource pool $ \c -> 
        runEitherT $ runReaderT (case t of T r -> r) c
    either (S . lift . left . TransactionError) return e


-- ** Error
-------------------------

data TransactionError


-- * Levels
-------------------------

data Read

read :: MonadIO m => (forall s. T Read s r) -> S m r
read = transaction


data Write

write :: MonadIO m => (forall s. T Write s r) -> S m r
write = transaction


data Admin

admin :: MonadIO m => (forall s. T Admin s r) -> S m r
admin = transaction


-- * Privileges
-------------------------

-- |
-- "SELECT"
class SelectPrivilege l

instance SelectPrivilege Read
instance SelectPrivilege Write

select :: SelectPrivilege l => Statement -> ResultsStream s (T l s) r
select = 
  $notImplemented


-- |
-- "UPDATE", "INSERT", "DELETE"
class UpdatePrivilege l

instance UpdatePrivilege Write

update :: UpdatePrivilege l => Statement -> T l s ()
update =
  $notImplemented


-- |
-- "CREATE", "ALTER", "DROP", "TRUNCATE"
class CreatePrivilege l

instance CreatePrivilege Admin

create :: CreatePrivilege l => Statement -> T l s ()
create =
  $notImplemented


-- * Statement
-------------------------

data Statement =
  Statement !ByteString ![Backend.Value]
  deriving (Show)

<commit_msg>Switch from transformer-based resource management to IO due to potential concurrency issues<commit_after>module HighSQL.API where

import HighSQL.Prelude hiding (read, Read, write, Write)
import qualified Data.Pool as Pool
import qualified HighSQL.CompositionT as CompositionT
import qualified HighSQL.Backend as Backend
import qualified ListT


-- * Session
-------------------------

data Session = 
  Session !(Pool.Pool Backend.Connection)

-- |
-- Session settings.
data Settings =
  Settings {
    -- | 
    -- The number of stripes (distinct sub-pools) to maintain. 
    -- The smallest acceptable value is 1.
    striping1 :: Word32,
    -- |
    -- Maximum number of connections to keep open per stripe. 
    -- The smallest acceptable value is 1.
    -- Requests for connections will block if this limit is reached 
    -- on a single stripe, 
    -- even if other stripes have idle connections available.
    striping2 :: Word32,
    -- |
    -- The amount of time for which an unused resource is kept open. 
    -- The smallest acceptable value is 0.5 seconds.
    -- The elapsed time before destroying a resource 
    -- may be a little longer than requested, 
    -- as the reaper thread wakes at 1-second intervals.
    connectionTimeout :: NominalDiffTime
  }

withSession :: Backend.Backend -> Settings -> (Session -> IO a) -> IO a
withSession b s =
  bracket acquire release
  where
    acquire = 
      do
        pool <-
          Pool.createPool 
            (Backend.connect b) (Backend.disconnect) (striping1 s)
            (connectionTimeout s) (striping2 s)
        return (Session pool)
    release (Session pool) =
      Pool.purgePool pool


-- ** Error
-------------------------

data SessionError =
  TransactionError TransactionError
  deriving (Show, Typeable)


-- * Transaction
-------------------------

-- |
-- A transaction with a level @l@ and a result @r@.
newtype T l s r =
  T (CompositionT.T (ReaderT Backend.Connection (EitherT TransactionError IO)) r)
  deriving (Functor, Applicative, Monad)

transaction :: Session -> (forall s. T l s r) -> IO r
transaction (Session p) t = 
  do
    e <- 
      Pool.withResource p $ runEitherT . \c -> 
        case composed of
          False -> 
            runReaderT r c
          True ->
            do
              $notImplemented
    either throwIO return e
  where
    (composed, r) = case t of T t -> CompositionT.run t


-- ** Error
-------------------------

data TransactionError =
  TE
  deriving (Show, Typeable)

instance Exception TransactionError


-- * Levels
-------------------------

data Read

read :: MonadIO m => Session -> (forall s. T Read s r) -> IO r
read = transaction


data Write

write :: MonadIO m => Session -> (forall s. T Write s r) -> IO r
write = transaction


data Admin

admin :: MonadIO m => Session -> (forall s. T Admin s r) -> IO r
admin = transaction


-- * Privileges
-------------------------

-- |
-- "SELECT"
class SelectPrivilege l

instance SelectPrivilege Read
instance SelectPrivilege Write

select :: SelectPrivilege l => Statement -> ResultsStream s (T l s) r
select = 
  $notImplemented


-- |
-- "UPDATE", "INSERT", "DELETE"
class UpdatePrivilege l

instance UpdatePrivilege Write

update :: UpdatePrivilege l => Statement -> T l s (Maybe Integer)
update =
  $notImplemented


-- |
-- "CREATE", "ALTER", "DROP", "TRUNCATE"
class CreatePrivilege l

instance CreatePrivilege Admin

create :: CreatePrivilege l => Statement -> T l s ()
create =
  $notImplemented


-- * Statement
-------------------------

data Statement =
  Statement !ByteString ![Backend.Value]
  deriving (Show)


{'fraction_non_alphanumeric': 0.14971657219073026, 'fraction_numerical': 0.0021673891297099034, 'mean_word_length': 2.2709923664122136, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 46, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2721610', 'n_tokens_mistral': 1765, 'n_tokens_neox': 1698, 'n_words': 664}