-- |
-- Explicit error types for all Hasql operations.
--
-- This module provides access to all error types used throughout Hasql:
--
-- * 'ConnectionError' - errors that occur when establishing a database connection
-- * 'SessionError' - errors that occur during session execution
--
-- The module follows Hasql's philosophy of explicit error handling,
-- where all errors are represented as values rather than exceptions.
module Hasql.Errors
  ( -- * Error class
    IsError (..),
    toDetailedText,

    -- * Connection errors
    ConnectionError (..),

    -- * Session errors
    SessionError (..),
    StatementError (..),
    RowError (..),
    CellError (..),
    ServerError (..),
  )
where

import Data.HashSet qualified as HashSet
import Data.Text qualified as Text
import Hasql.Engine.Errors
import Hasql.Platform.Prelude
import TextBuilder qualified

-- * Classes

-- | A class for types that can be treated as errors.
class IsError a where
  -- | Convert the error to a human-readable message with no dynamic details.
  toMessage :: a -> Text

  -- | Convert the error to a list of key-value pairs of dynamic details.
  toDetails :: a -> [(Text, Text)]

  -- | Whether the error is transient and the operation causing it can be retried.
  isTransient :: a -> Bool

-- | Convert the error to a multiline detailed human-readable text representation containing all details.
toDetailedText :: (IsError e) => e -> Text
toDetailedText :: forall e. IsError e => e -> Text
toDetailedText = TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (e -> TextBuilder) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> TextBuilder
forall e. IsError e => e -> TextBuilder
toDetailedTextBuilder

-- | Convert the error to a multiline detailed human-readable text representation containing all details.
toDetailedTextBuilder :: (IsError e) => e -> TextBuilder
toDetailedTextBuilder :: forall e. IsError e => e -> TextBuilder
toDetailedTextBuilder e
err =
  Text -> TextBuilder
TextBuilder.text (e -> Text
forall e. IsError e => e -> Text
toMessage e
err)
    TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> TextBuilder) -> [(Text, Text)] -> TextBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      ( \(Text
key, Text
value) ->
          [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
            [ TextBuilder
"\n  ",
              Text -> TextBuilder
TextBuilder.text Text
key,
              case Text -> [Text]
Text.lines Text
value of
                [] -> TextBuilder
":"
                [Text
singleLine] ->
                  TextBuilder
": " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> TextBuilder
TextBuilder.text Text
singleLine
                [Text]
multipleLines ->
                  TextBuilder
":" TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> (Text -> TextBuilder) -> [Text] -> TextBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TextBuilder -> TextBuilder -> TextBuilder
forall a. Monoid a => a -> a -> a
mappend TextBuilder
"\n    " (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> TextBuilder
TextBuilder.text) [Text]
multipleLines
            ]
      )
      (e -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails e
err)

-- * Instances

instance IsError ConnectionError where
  toMessage :: ConnectionError -> Text
toMessage = \case
    NetworkingConnectionError {} ->
      Text
"Networking error while connecting to the database"
    AuthenticationConnectionError {} ->
      Text
"Authentication error while connecting to the database"
    CompatibilityConnectionError {} ->
      Text
"Compatibility error while connecting to the database"
    OtherConnectionError {} ->
      Text
"Connection error while connecting to the database"

  toDetails :: ConnectionError -> [(Text, Text)]
toDetails = \case
    NetworkingConnectionError Text
reason ->
      [(Text
"reason", Text
reason)]
    AuthenticationConnectionError Text
reason ->
      [(Text
"reason", Text
reason)]
    CompatibilityConnectionError Text
reason ->
      [(Text
"reason", Text
reason)]
    OtherConnectionError Text
reason ->
      [(Text
"reason", Text
reason)]

  isTransient :: ConnectionError -> Bool
isTransient = \case
    NetworkingConnectionError {} -> Bool
True
    AuthenticationConnectionError {} -> Bool
False
    CompatibilityConnectionError {} -> Bool
False
    OtherConnectionError {} -> Bool
False

instance IsError ServerError where
  toMessage :: ServerError -> Text
toMessage ServerError
_ =
    Text
"Server error"

  toDetails :: ServerError -> [(Text, Text)]
toDetails (ServerError Text
code Text
message Maybe Text
detail Maybe Text
hint Maybe Int
position) =
    [[(Text, Text)]] -> [(Text, Text)]
forall a. Monoid a => [a] -> a
mconcat
      [ [(Text
"code", Text
code), (Text
"message", Text
message)],
        [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
d -> [(Text
"detail", Text
d)]) Maybe Text
detail,
        [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
h -> [(Text
"hint", Text
h)]) Maybe Text
hint,
        [(Text, Text)]
-> (Int -> [(Text, Text)]) -> Maybe Int -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
p -> [(Text
"position", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
p)]) Maybe Int
position
      ]

  isTransient :: ServerError -> Bool
isTransient = Bool -> ServerError -> Bool
forall a b. a -> b -> a
const Bool
False

instance IsError CellError where
  toMessage :: CellError -> Text
toMessage = \case
    CellError
UnexpectedNullCellError ->
      Text
"Unexpected null value"
    DeserializationCellError {} ->
      Text
"Failed to deserialize cell"

  toDetails :: CellError -> [(Text, Text)]
toDetails = \case
    CellError
UnexpectedNullCellError ->
      []
    DeserializationCellError Text
reason ->
      [(Text
"reason", Text
reason)]

  isTransient :: CellError -> Bool
isTransient = Bool -> CellError -> Bool
forall a b. a -> b -> a
const Bool
False

instance IsError StatementError where
  toMessage :: StatementError -> Text
toMessage = \case
    ServerStatementError ServerError
executionError ->
      ServerError -> Text
forall e. IsError e => e -> Text
toMessage ServerError
executionError
    UnexpectedRowCountStatementError {} ->
      Text
"Unexpected number of rows"
    UnexpectedColumnCountStatementError {} ->
      Text
"Unexpected number of columns"
    UnexpectedColumnTypeStatementError {} ->
      Text
"Unexpected column type"
    RowStatementError Int
_ RowError
rowError ->
      RowError -> Text
forall e. IsError e => e -> Text
toMessage RowError
rowError
    UnexpectedResultStatementError {} ->
      Text
"Driver error"

  toDetails :: StatementError -> [(Text, Text)]
toDetails = \case
    ServerStatementError ServerError
executionError ->
      ServerError -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails ServerError
executionError
    UnexpectedRowCountStatementError Int
min Int
max Int
actual ->
      [ (Text
"expectedMin", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
min),
        (Text
"expectedMax", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
max),
        (Text
"actual", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
actual)
      ]
    UnexpectedColumnCountStatementError Int
expected Int
actual ->
      [ (Text
"expected", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
expected),
        (Text
"actual", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
actual)
      ]
    UnexpectedColumnTypeStatementError Int
colIdx Word32
expected Word32
actual ->
      [ (Text
"columnIndex", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
colIdx),
        (Text
"expectedOid", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Word32 -> TextBuilder) -> Word32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Word32
expected),
        (Text
"actualOid", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Word32 -> TextBuilder) -> Word32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Word32
actual)
      ]
    RowStatementError Int
rowIdx RowError
rowError ->
      (Text
"rowIndex", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
rowIdx) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: RowError -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails RowError
rowError
    UnexpectedResultStatementError Text
reason ->
      [(Text
"reason", Text
reason)]

  isTransient :: StatementError -> Bool
isTransient = Bool -> StatementError -> Bool
forall a b. a -> b -> a
const Bool
False

instance IsError RowError where
  toMessage :: RowError -> Text
toMessage = \case
    CellRowError Int
_ Word32
_ CellError
cellErr ->
      CellError -> Text
forall e. IsError e => e -> Text
toMessage CellError
cellErr
    RefinementRowError {} ->
      Text
"Refinement error"

  toDetails :: RowError -> [(Text, Text)]
toDetails = \case
    CellRowError Int
colIdx Word32
oid CellError
cellErr ->
      [ (Text
"columnIndex", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
colIdx),
        (Text
"oid", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Word32 -> TextBuilder) -> Word32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Word32
oid)
      ]
        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> CellError -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails CellError
cellErr
    RefinementRowError Text
reason ->
      [(Text
"reason", Text
reason)]

  isTransient :: RowError -> Bool
isTransient = Bool -> RowError -> Bool
forall a b. a -> b -> a
const Bool
False

instance IsError SessionError where
  toMessage :: SessionError -> Text
toMessage = \case
    StatementSessionError Int
_ Int
_ Text
_ [Text]
_ Bool
_ StatementError
statementError ->
      StatementError -> Text
forall e. IsError e => e -> Text
toMessage StatementError
statementError
    ScriptSessionError Text
_ ServerError
execErr ->
      ServerError -> Text
forall e. IsError e => e -> Text
toMessage ServerError
execErr
    ConnectionSessionError {} ->
      Text
"Connection error"
    DriverSessionError {} ->
      Text
"Driver error"
    MissingTypesSessionError {} ->
      Text
"Types not found in database"

  toDetails :: SessionError -> [(Text, Text)]
toDetails = \case
    StatementSessionError Int
totalStatements Int
statementIndex Text
sql [Text]
parameters Bool
prepared StatementError
statementError ->
      [ (Text
"totalStatements", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
totalStatements),
        (Text
"statementIndex", (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (Int -> TextBuilder) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
TextBuilder.decimal) Int
statementIndex),
        (Text
"sql", Text
sql),
        (Text
"parameters", Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
parameters),
        (Text
"prepared", if Bool
prepared then Text
"true" else Text
"false")
      ]
        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> StatementError -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails StatementError
statementError
    ScriptSessionError Text
sql ServerError
execErr ->
      (Text
"sql", Text
sql) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: ServerError -> [(Text, Text)]
forall a. IsError a => a -> [(Text, Text)]
toDetails ServerError
execErr
    ConnectionSessionError Text
reason ->
      [(Text
"reason", Text
reason)]
    DriverSessionError Text
reason ->
      [(Text
"reason", Text
reason)]
    MissingTypesSessionError HashSet (Maybe Text, Text)
missingTypes ->
      [ ( Text
"missingTypes",
          (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text)
-> (HashSet (Maybe Text, Text) -> TextBuilder)
-> HashSet (Maybe Text, Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat ([TextBuilder] -> TextBuilder)
-> (HashSet (Maybe Text, Text) -> [TextBuilder])
-> HashSet (Maybe Text, Text)
-> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> [TextBuilder] -> [TextBuilder]
forall a. a -> [a] -> [a]
intersperse TextBuilder
", " ([TextBuilder] -> [TextBuilder])
-> (HashSet (Maybe Text, Text) -> [TextBuilder])
-> HashSet (Maybe Text, Text)
-> [TextBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Maybe Text, Text) -> TextBuilder)
-> [(Maybe Text, Text)] -> [TextBuilder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text, Text) -> TextBuilder
formatType ([(Maybe Text, Text)] -> [TextBuilder])
-> (HashSet (Maybe Text, Text) -> [(Maybe Text, Text)])
-> HashSet (Maybe Text, Text)
-> [TextBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HashSet (Maybe Text, Text) -> [(Maybe Text, Text)]
forall a. HashSet a -> [a]
HashSet.toList) HashSet (Maybe Text, Text)
missingTypes
        )
      ]
      where
        formatType :: (Maybe Text, Text) -> TextBuilder
formatType (Maybe Text
schema, Text
name) = TextBuilder -> (Text -> TextBuilder) -> Maybe Text -> TextBuilder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextBuilder
"" ((TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
".") (TextBuilder -> TextBuilder)
-> (Text -> TextBuilder) -> Text -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> TextBuilder
TextBuilder.text) Maybe Text
schema TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> TextBuilder
TextBuilder.text Text
name

  isTransient :: SessionError -> Bool
isTransient = \case
    ConnectionSessionError Text
_ -> Bool
True
    StatementSessionError {} -> Bool
False
    ScriptSessionError {} -> Bool
False
    DriverSessionError {} -> Bool
False
    MissingTypesSessionError {} -> Bool
False