{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}

module HaskellWorks.Error.Types.YamlDecodeError
  ( YamlDecodeError(..)
  ) where


import           Data.Aeson           (ToJSON (..), (.=))
import qualified Data.Aeson           as J
import           GHC.Generics
import           HaskellWorks.Prelude
newtype YamlDecodeError =
  YamlDecodeError
  { YamlDecodeError -> Text
message :: Text
  }
  deriving (YamlDecodeError -> YamlDecodeError -> Bool
(YamlDecodeError -> YamlDecodeError -> Bool)
-> (YamlDecodeError -> YamlDecodeError -> Bool)
-> Eq YamlDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YamlDecodeError -> YamlDecodeError -> Bool
== :: YamlDecodeError -> YamlDecodeError -> Bool
$c/= :: YamlDecodeError -> YamlDecodeError -> Bool
/= :: YamlDecodeError -> YamlDecodeError -> Bool
Eq, (forall x. YamlDecodeError -> Rep YamlDecodeError x)
-> (forall x. Rep YamlDecodeError x -> YamlDecodeError)
-> Generic YamlDecodeError
forall x. Rep YamlDecodeError x -> YamlDecodeError
forall x. YamlDecodeError -> Rep YamlDecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. YamlDecodeError -> Rep YamlDecodeError x
from :: forall x. YamlDecodeError -> Rep YamlDecodeError x
$cto :: forall x. Rep YamlDecodeError x -> YamlDecodeError
to :: forall x. Rep YamlDecodeError x -> YamlDecodeError
Generic, Int -> YamlDecodeError -> ShowS
[YamlDecodeError] -> ShowS
YamlDecodeError -> String
(Int -> YamlDecodeError -> ShowS)
-> (YamlDecodeError -> String)
-> ([YamlDecodeError] -> ShowS)
-> Show YamlDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YamlDecodeError -> ShowS
showsPrec :: Int -> YamlDecodeError -> ShowS
$cshow :: YamlDecodeError -> String
show :: YamlDecodeError -> String
$cshowList :: [YamlDecodeError] -> ShowS
showList :: [YamlDecodeError] -> ShowS
Show)

instance ToJSON YamlDecodeError where
  toJSON :: YamlDecodeError -> Value
toJSON YamlDecodeError
e =
        [Pair] -> Value
J.object
            [ Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. a -> a
id @Text Text
"YamlDecodeError"
            , Key
"message" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= YamlDecodeError
e.message
            ]