module Hasql.Errors where

import Data.ByteString.Char8 qualified as BC
import Hasql.Prelude

-- | Error during execution of a session.
data SessionError
  = -- | Error during the execution of a query.
    -- Comes packed with the query template and a textual representation of the provided params.
    QueryError
      -- | SQL template.
      ByteString
      -- | Parameters rendered as human-readable SQL literals.
      [Text]
      -- | Error details.
      CommandError
  | -- | Error during the execution of a pipeline.
    PipelineError
      -- | Error details.
      CommandError
  deriving (Int -> SessionError -> ShowS
[SessionError] -> ShowS
SessionError -> String
(Int -> SessionError -> ShowS)
-> (SessionError -> String)
-> ([SessionError] -> ShowS)
-> Show SessionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionError -> ShowS
showsPrec :: Int -> SessionError -> ShowS
$cshow :: SessionError -> String
show :: SessionError -> String
$cshowList :: [SessionError] -> ShowS
showList :: [SessionError] -> ShowS
Show, SessionError -> SessionError -> Bool
(SessionError -> SessionError -> Bool)
-> (SessionError -> SessionError -> Bool) -> Eq SessionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionError -> SessionError -> Bool
== :: SessionError -> SessionError -> Bool
$c/= :: SessionError -> SessionError -> Bool
/= :: SessionError -> SessionError -> Bool
Eq, Typeable)

instance Exception SessionError where
  displayException :: SessionError -> String
displayException = \case
    QueryError ByteString
query [Text]
params CommandError
commandError ->
      let queryContext :: Maybe (ByteString, Int)
          queryContext :: Maybe (ByteString, Int)
queryContext = case CommandError
commandError of
            ClientError Maybe ByteString
_ -> Maybe (ByteString, Int)
forall a. Maybe a
Nothing
            ResultError ResultError
resultError -> case ResultError
resultError of
              ServerError ByteString
_ ByteString
message Maybe ByteString
_ Maybe ByteString
_ (Just Int
position) -> (ByteString, Int) -> Maybe (ByteString, Int)
forall a. a -> Maybe a
Just (ByteString
message, Int
position)
              ResultError
_ -> Maybe (ByteString, Int)
forall a. Maybe a
Nothing

          -- find the line number and position of the error
          findLineAndPos :: ByteString -> Int -> (Int, Int)
          findLineAndPos :: ByteString -> Int -> (Int, Int)
findLineAndPos ByteString
byteString Int
errorPos =
            let (Int
_, Int
line, Int
pos) =
                  ((Int, Int, Int) -> Char -> (Int, Int, Int))
-> (Int, Int, Int) -> ByteString -> (Int, Int, Int)
forall a. (a -> Char -> a) -> a -> ByteString -> a
BC.foldl'
                    ( \(Int
total, Int
line, Int
pos) Char
c ->
                        case Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 of
                          Int
0 -> (Int
total, Int
line, Int
pos)
                          Int
cursor
                            | Int
cursor Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
errorPos -> (-Int
1, Int
line, Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' -> (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0)
                            | Bool
otherwise -> (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
line, Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    )
                    (Int
0, Int
1, Int
0)
                    ByteString
byteString
             in (Int
line, Int
pos)

          formatErrorContext :: ByteString -> ByteString -> Int -> ByteString
          formatErrorContext :: ByteString -> ByteString -> Int -> ByteString
formatErrorContext ByteString
query ByteString
message Int
errorPos =
            let lines :: [ByteString]
lines = ByteString -> [ByteString]
BC.lines ByteString
query
                (Int
lineNum, Int
linePos) = ByteString -> Int -> (Int, Int)
findLineAndPos ByteString
query Int
errorPos
             in [ByteString] -> ByteString
BC.unlines (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
lineNum [ByteString]
lines)
                  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
BC.replicate (Int
linePos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
' '
                  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"^ "
                  ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
message

          prettyQuery :: ByteString
          prettyQuery :: ByteString
prettyQuery = case Maybe (ByteString, Int)
queryContext of
            Maybe (ByteString, Int)
Nothing -> ByteString
query
            Just (ByteString
message, Int
pos) -> ByteString -> ByteString -> Int -> ByteString
formatErrorContext ByteString
query ByteString
message Int
pos
       in String
"QueryError!\n"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  Query:\n"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BC.unpack ByteString
prettyQuery
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  Params: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
params
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  Error: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CommandError -> String
renderCommandErrorAsReason CommandError
commandError
    PipelineError CommandError
commandError ->
      String
"PipelineError!\n  Reason: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CommandError -> String
renderCommandErrorAsReason CommandError
commandError
    where
      renderCommandErrorAsReason :: CommandError -> String
renderCommandErrorAsReason = \case
        ClientError (Just ByteString
message) -> String
"Client error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
message
        ClientError Maybe ByteString
Nothing -> String
"Client error without details"
        ResultError ResultError
resultError -> case ResultError
resultError of
          ServerError ByteString
code ByteString
message Maybe ByteString
details Maybe ByteString
hint Maybe Int
position ->
            String
"Server error "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BC.unpack ByteString
code
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BC.unpack ByteString
message
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ByteString
d -> String
"\n  Details: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BC.unpack ByteString
d) Maybe ByteString
details
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ByteString
h -> String
"\n  Hint: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BC.unpack ByteString
h) Maybe ByteString
hint
          UnexpectedResult Text
message -> String
"Unexpected result: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
message
          RowError Int
row Int
column RowError
rowError ->
            String
"Error in row " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
row String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", column " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
column String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RowError -> String
forall a. Show a => a -> String
show RowError
rowError
          UnexpectedAmountOfRows Int
amount ->
            String
"Unexpected amount of rows: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
amount

-- |
-- An error of some command in the session.
data CommandError
  = -- |
    -- An error on the client-side,
    -- with a message generated by the \"libpq\" library.
    -- Usually indicates problems with connection.
    ClientError (Maybe ByteString)
  | -- |
    -- Some error with a command result.
    ResultError ResultError
  deriving (Int -> CommandError -> ShowS
[CommandError] -> ShowS
CommandError -> String
(Int -> CommandError -> ShowS)
-> (CommandError -> String)
-> ([CommandError] -> ShowS)
-> Show CommandError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandError -> ShowS
showsPrec :: Int -> CommandError -> ShowS
$cshow :: CommandError -> String
show :: CommandError -> String
$cshowList :: [CommandError] -> ShowS
showList :: [CommandError] -> ShowS
Show, CommandError -> CommandError -> Bool
(CommandError -> CommandError -> Bool)
-> (CommandError -> CommandError -> Bool) -> Eq CommandError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandError -> CommandError -> Bool
== :: CommandError -> CommandError -> Bool
$c/= :: CommandError -> CommandError -> Bool
/= :: CommandError -> CommandError -> Bool
Eq)

-- |
-- An error with a command result.
data ResultError
  = -- | An error reported by the DB.
    ServerError
      -- | __Code__. The SQLSTATE code for the error. It's recommended to use
      -- <http://hackage.haskell.org/package/postgresql-error-codes
      -- the "postgresql-error-codes" package> to work with those.
      ByteString
      -- | __Message__. The primary human-readable error message(typically one
      -- line). Always present.
      ByteString
      -- | __Details__. An optional secondary error message carrying more
      -- detail about the problem. Might run to multiple lines.
      (Maybe ByteString)
      -- | __Hint__. An optional suggestion on what to do about the problem.
      -- This is intended to differ from detail in that it offers advice
      -- (potentially inappropriate) rather than hard facts. Might run to
      -- multiple lines.
      (Maybe ByteString)
      -- | __Position__. Error cursor position as an index into the original
      -- statement string. Positions are measured in characters not bytes.
      (Maybe Int)
  | -- |
    -- The database returned an unexpected result.
    -- Indicates an improper statement or a schema mismatch.
    UnexpectedResult Text
  | -- |
    -- An error of the row reader, preceded by the indexes of the row and column.
    RowError Int Int RowError
  | -- |
    -- An unexpected amount of rows.
    UnexpectedAmountOfRows Int
  deriving (Int -> ResultError -> ShowS
[ResultError] -> ShowS
ResultError -> String
(Int -> ResultError -> ShowS)
-> (ResultError -> String)
-> ([ResultError] -> ShowS)
-> Show ResultError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResultError -> ShowS
showsPrec :: Int -> ResultError -> ShowS
$cshow :: ResultError -> String
show :: ResultError -> String
$cshowList :: [ResultError] -> ShowS
showList :: [ResultError] -> ShowS
Show, ResultError -> ResultError -> Bool
(ResultError -> ResultError -> Bool)
-> (ResultError -> ResultError -> Bool) -> Eq ResultError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultError -> ResultError -> Bool
== :: ResultError -> ResultError -> Bool
$c/= :: ResultError -> ResultError -> Bool
/= :: ResultError -> ResultError -> Bool
Eq)

-- |
-- An error during the decoding of a specific row.
data RowError
  = -- |
    -- Appears on the attempt to parse more columns than there are in the result.
    EndOfInput
  | -- |
    -- Appears on the attempt to parse a @NULL@ as some value.
    UnexpectedNull
  | -- |
    -- Appears when a wrong value parser is used.
    -- Comes with the error details.
    ValueError Text
  deriving (Int -> RowError -> ShowS
[RowError] -> ShowS
RowError -> String
(Int -> RowError -> ShowS)
-> (RowError -> String) -> ([RowError] -> ShowS) -> Show RowError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowError -> ShowS
showsPrec :: Int -> RowError -> ShowS
$cshow :: RowError -> String
show :: RowError -> String
$cshowList :: [RowError] -> ShowS
showList :: [RowError] -> ShowS
Show, RowError -> RowError -> Bool
(RowError -> RowError -> Bool)
-> (RowError -> RowError -> Bool) -> Eq RowError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowError -> RowError -> Bool
== :: RowError -> RowError -> Bool
$c/= :: RowError -> RowError -> Bool
/= :: RowError -> RowError -> Bool
Eq)