{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy           #-}
module Data.MessagePack.Types.DecodeError
    ( DecodeError
    , decodeError
    , errorMessages
    ) where

import           Control.Monad.Validate          (MonadValidate (..))
import           Data.String                     (IsString (..))
import           Text.ParserCombinators.ReadPrec (ReadPrec)

data DecodeError = DecodeError
    { DecodeError -> [String]
errorMessages :: [String]
    }
    deriving (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeError] -> ShowS
$cshowList :: [DecodeError] -> ShowS
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> ShowS
$cshowsPrec :: Int -> DecodeError -> ShowS
Show)

decodeError :: String -> DecodeError
decodeError :: String -> DecodeError
decodeError = [String] -> DecodeError
DecodeError ([String] -> DecodeError)
-> (String -> [String]) -> String -> DecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[])

instance IsString DecodeError where
    fromString :: String -> DecodeError
fromString String
str = [String] -> DecodeError
DecodeError [String
str]

instance Semigroup DecodeError where
    DecodeError [String]
a <> :: DecodeError -> DecodeError -> DecodeError
<> DecodeError [String]
b = [String] -> DecodeError
DecodeError ([String]
a [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
b)

instance MonadValidate DecodeError ReadPrec where
    refute :: DecodeError -> ReadPrec a
refute = String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadPrec a)
-> (DecodeError -> String) -> DecodeError -> ReadPrec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> String
forall a. Show a => a -> String
show
    tolerate :: ReadPrec a -> ReadPrec (Maybe a)
tolerate ReadPrec a
m = ReadPrec a
m ReadPrec a -> ReadPrec (Maybe a) -> ReadPrec (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> ReadPrec (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing