-- |
--
-- 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 Data.JSON.Patch.Prelude

import Data.Aeson (Value, encode)
import Data.ByteString.Lazy.Char8 as BSL8
import Data.JSON.Pointer
import Data.Vector qualified as V

data PatchError
  = ParseError Value String
  | PointerNotFound Value Pointer
  | InvalidObjectOperation Pointer Value
  | InvalidArrayOperation Pointer Value
  | IndexOutOfBounds Pointer Int (Vector Value)
  | EmptyArray Pointer
  | 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
showValue Value
v)
    PointerNotFound Value
v Pointer
ts ->
      String
"Path "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pointer -> String
pointerToString Pointer
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist in "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
showValue Value
v
    InvalidObjectOperation Pointer
ts Value
v ->
      String
"Cannot perform object operation on non-object at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pointer -> String
pointerToString Pointer
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
showValue Value
v
    InvalidArrayOperation Pointer
ts Value
v ->
      String
"Cannot perform array operation on non-array at "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pointer -> String
pointerToString Pointer
ts
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
showValue Value
v
    IndexOutOfBounds Pointer
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
<> Pointer -> String
pointerToString Pointer
ts
    EmptyArray Pointer
ts ->
      String
"Cannot perform operation on empty array at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Pointer -> String
pointerToString Pointer
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
showValue 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
showValue Value
actual)

showValue :: Value -> String
showValue :: Value -> String
showValue = ByteString -> String
BSL8.unpack (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode