module Polysemy.Hasql.Session where

import qualified Data.Text as Text
import Exon (exon)
import Hasql.Connection (Connection)
import qualified Hasql.Session as Session
import Hasql.Session (CommandError (ClientError, ResultError), QueryError (QueryError), Session)
import Hasql.Statement (Statement)
import qualified Polysemy.Db.Data.DbConnectionError as DbConnectionError
import qualified Polysemy.Db.Data.DbError as DbError
import Polysemy.Db.Data.DbError (DbError)

convertQueryError :: QueryError -> DbError
convertQueryError :: QueryError -> DbError
convertQueryError (QueryError ByteString
template (Text -> [Text] -> Text
Text.intercalate Text
"," -> Text
args) CommandError
cmdError) =
  case CommandError
cmdError of
    ClientError Maybe ByteString
err ->
      DbConnectionError -> DbError
DbError.Connection (Text -> DbConnectionError
DbConnectionError.Query (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"no error" forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 Maybe ByteString
err))
    ResultError ResultError
err ->
      Text -> DbError
DbError.Query [exon|#{decodeUtf8 template} #{args} #{show err}|]

runSession ::
  Members [Stop DbError, Embed IO] r =>
  Connection ->
  Session a ->
  Sem r a
runSession :: forall (r :: EffectRow) a.
Members '[Stop DbError, Embed IO] r =>
Connection -> Session a -> Sem r a
runSession Connection
connection Session a
session = do
  Either Text (Either QueryError a)
result <- forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryIOError (forall a. Session a -> Connection -> IO (Either QueryError a)
Session.run Session a
session Connection
connection)
  forall err (r :: EffectRow) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first QueryError -> DbError
convertQueryError forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> DbError
DbError.Unexpected Either Text (Either QueryError a)
result)

runStatement ::
  Members [Stop DbError, Embed IO] r =>
  Connection ->
  p ->
  Statement p a ->
  Sem r a
runStatement :: forall (r :: EffectRow) p a.
Members '[Stop DbError, Embed IO] r =>
Connection -> p -> Statement p a -> Sem r a
runStatement Connection
connection p
p Statement p a
stmt =
  forall (r :: EffectRow) a.
Members '[Stop DbError, Embed IO] r =>
Connection -> Session a -> Sem r a
runSession Connection
connection (forall params result.
params -> Statement params result -> Session result
Session.statement p
p Statement p a
stmt)