-- |
--
-- Module      : Data.JSON.Patch.Error
-- Copyright   : (c) 2025 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Data.JSON.Patch.Error
  ( PatchError (..)
  ) where

import Prelude

import Control.Exception (Exception (..))
import Data.Aeson (Value)
import Data.JSON.Pointer
import Data.JSON.Pointer.Token
import Data.Vector (Vector)
import Data.Vector qualified as V

data PatchError
  = ParseError Value String
  | PointerNotFound [Token] (Maybe String)
  | InvalidObjectOperation [Token] Value
  | InvalidArrayOperation [Token] Value
  | IndexOutOfBounds [Token] Int (Vector Value)
  | EmptyArray [Token]
  | TestFailed Pointer Value Value
  deriving stock (Int -> PatchError -> ShowS
[PatchError] -> ShowS
PatchError -> String
(Int -> PatchError -> ShowS)
-> (PatchError -> String)
-> ([PatchError] -> ShowS)
-> Show PatchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatchError -> ShowS
showsPrec :: Int -> PatchError -> ShowS
$cshow :: PatchError -> String
show :: PatchError -> String
$cshowList :: [PatchError] -> ShowS
showList :: [PatchError] -> ShowS
Show)

instance Exception PatchError where
  displayException :: PatchError -> String
displayException = \case
    ParseError Value
v String
msg ->
      String
"Unable to parse Patch(es) from Value: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
"\n  error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
"\n  input: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v)
    PointerNotFound [Token]
ts Maybe String
mType ->
      String
"Path "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Token] -> String
tokensToString [Token]
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
" or is not " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) Maybe String
mType
    InvalidObjectOperation [Token]
ts Value
v ->
      String
"Cannot perform object operation on non-object at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Token] -> String
tokensToString [Token]
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v
    InvalidArrayOperation [Token]
ts Value
v ->
      String
"Cannot perform array operation on non-array at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Token] -> String
tokensToString [Token]
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v
    IndexOutOfBounds [Token]
ts Int
n Vector Value
vec ->
      String
"Index "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is out of bounds for vector of length "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vec)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Token] -> String
tokensToString [Token]
ts
    EmptyArray [Token]
ts ->
      String
"Cannot perform operation on empty array at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Token] -> String
tokensToString [Token]
ts
    TestFailed Pointer
p Value
actual Value
expected ->
      String
"Test failed at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pointer -> String
pointerToString Pointer
p
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
"\n  expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
expected)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (String
"\n    actual: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
actual)