module AesonValueParser.Error where

import AesonValueParser.Prelude
import qualified Data.Text as Text

data Error
  = Error
      [Text]
      -- ^ Path
      Text
      -- ^ Message

instance Semigroup Error where
  <> :: Error -> Error -> Error
(<>) Error
_ Error
b = Error
b

instance Monoid Error where
  mempty :: Error
mempty = [Text] -> Text -> Error
Error [] Text
""
  mappend :: Error -> Error -> Error
mappend = Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
(<>)

instance IsString Error where
  fromString :: String -> Error
fromString = Text -> Error
message (Text -> Error) -> (String -> Text) -> String -> Error
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Show Error where
  show :: Error -> String
show = Text -> String
Text.unpack (Text -> String) -> (Error -> Text) -> Error -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Error -> Text
toText

{-# INLINE indexed #-}
indexed :: Int -> Error -> Error
indexed :: Int -> Error -> Error
indexed = Text -> Error -> Error
named (Text -> Error -> Error) -> (Int -> Text) -> Int -> Error -> Error
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Int -> String) -> Int -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> String
forall a. Show a => a -> String
show

{-# INLINE named #-}
named :: Text -> Error -> Error
named :: Text -> Error -> Error
named Text
name (Error [Text]
path Text
message) = [Text] -> Text -> Error
Error (Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
path) Text
message

{-# INLINE message #-}
message :: Text -> Error
message :: Text -> Error
message = [Text] -> Text -> Error
Error []

toText :: Error -> Text
toText :: Error -> Text
toText (Error [Text]
path Text
message) =
  Text
"AST parsing error at path "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
x -> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) [Text]
path
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message