2024-04-22 07:32:56 +03:00
|
|
|
module Hasql.TestingKit.TestingDsl
|
2024-04-22 07:45:41 +03:00
|
|
|
( -- * Errors
|
2024-04-21 12:34:19 +03:00
|
|
|
Error (..),
|
|
|
|
Session.SessionError (..),
|
2024-04-22 07:02:26 +03:00
|
|
|
Session.CommandError (..),
|
2024-04-22 07:45:41 +03:00
|
|
|
Session.ResultError (..),
|
|
|
|
Session.RowError (..),
|
|
|
|
Session.ColumnError (..),
|
|
|
|
|
|
|
|
-- * Abstractions
|
|
|
|
Session.Session,
|
2024-04-20 16:40:11 +03:00
|
|
|
Pipeline.Pipeline,
|
|
|
|
Statement.Statement (..),
|
2024-04-22 07:45:41 +03:00
|
|
|
|
|
|
|
-- * Execution
|
2024-04-20 14:01:58 +03:00
|
|
|
runSessionOnLocalDb,
|
2024-04-20 16:40:11 +03:00
|
|
|
runPipelineOnLocalDb,
|
2024-04-20 13:46:51 +03:00
|
|
|
runStatementInSession,
|
2024-04-20 16:40:11 +03:00
|
|
|
runPipelineInSession,
|
2024-04-20 13:46:51 +03:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
import Hasql.Connection qualified as Connection
|
2024-04-20 16:40:11 +03:00
|
|
|
import Hasql.Pipeline qualified as Pipeline
|
2024-04-20 13:46:51 +03:00
|
|
|
import Hasql.Session qualified as Session
|
|
|
|
import Hasql.Statement qualified as Statement
|
2024-04-22 07:32:56 +03:00
|
|
|
import Hasql.TestingKit.Constants qualified as Constants
|
2024-04-20 13:46:51 +03:00
|
|
|
import Prelude
|
|
|
|
|
2024-04-21 12:34:19 +03:00
|
|
|
data Error
|
2024-04-20 13:46:51 +03:00
|
|
|
= ConnectionError (Connection.ConnectionError)
|
2024-04-21 12:34:19 +03:00
|
|
|
| SessionError (Session.SessionError)
|
2024-04-20 13:46:51 +03:00
|
|
|
deriving (Show, Eq)
|
|
|
|
|
2024-04-21 12:34:19 +03:00
|
|
|
runSessionOnLocalDb :: Session.Session a -> IO (Either Error a)
|
2024-04-20 14:01:58 +03:00
|
|
|
runSessionOnLocalDb session =
|
2024-04-20 13:46:51 +03:00
|
|
|
runExceptT $ acquire >>= \connection -> use connection <* release connection
|
|
|
|
where
|
|
|
|
acquire =
|
2024-04-20 13:59:11 +03:00
|
|
|
ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire Constants.localConnectionSettings
|
2024-04-20 13:46:51 +03:00
|
|
|
use connection =
|
|
|
|
ExceptT
|
|
|
|
$ fmap (mapLeft SessionError)
|
|
|
|
$ Session.run session connection
|
|
|
|
release connection =
|
|
|
|
lift $ Connection.release connection
|
|
|
|
|
2024-04-21 12:34:19 +03:00
|
|
|
runPipelineOnLocalDb :: Pipeline.Pipeline a -> IO (Either Error a)
|
2024-04-20 16:40:11 +03:00
|
|
|
runPipelineOnLocalDb =
|
|
|
|
runSessionOnLocalDb . Session.pipeline
|
|
|
|
|
2024-04-20 13:46:51 +03:00
|
|
|
runStatementInSession :: Statement.Statement a b -> a -> Session.Session b
|
|
|
|
runStatementInSession statement params =
|
|
|
|
Session.statement params statement
|
2024-04-20 16:40:11 +03:00
|
|
|
|
|
|
|
runPipelineInSession :: Pipeline.Pipeline a -> Session.Session a
|
|
|
|
runPipelineInSession =
|
|
|
|
Session.pipeline
|