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

module HaskellWorks.Error.Types.JsonDecodeError
  ( JsonDecodeError(..)
  , newJsonDecodeError
  ) where


import           Data.Aeson           (ToJSON (..), Value, (.=))
import qualified Data.Aeson           as J
import           GHC.Generics

import           HaskellWorks.Prelude
import           HaskellWorks.ToText

data JsonDecodeError =
  JsonDecodeError
  { JsonDecodeError -> Text
message    :: Text
  , JsonDecodeError -> Maybe ByteString
bytestring :: Maybe ByteString
  , JsonDecodeError -> Maybe Text
text       :: Maybe Text
  , JsonDecodeError -> Maybe Value
json       :: Maybe Value
  }
  deriving (JsonDecodeError -> JsonDecodeError -> Bool
(JsonDecodeError -> JsonDecodeError -> Bool)
-> (JsonDecodeError -> JsonDecodeError -> Bool)
-> Eq JsonDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonDecodeError -> JsonDecodeError -> Bool
== :: JsonDecodeError -> JsonDecodeError -> Bool
$c/= :: JsonDecodeError -> JsonDecodeError -> Bool
/= :: JsonDecodeError -> JsonDecodeError -> Bool
Eq, (forall x. JsonDecodeError -> Rep JsonDecodeError x)
-> (forall x. Rep JsonDecodeError x -> JsonDecodeError)
-> Generic JsonDecodeError
forall x. Rep JsonDecodeError x -> JsonDecodeError
forall x. JsonDecodeError -> Rep JsonDecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonDecodeError -> Rep JsonDecodeError x
from :: forall x. JsonDecodeError -> Rep JsonDecodeError x
$cto :: forall x. Rep JsonDecodeError x -> JsonDecodeError
to :: forall x. Rep JsonDecodeError x -> JsonDecodeError
Generic, Int -> JsonDecodeError -> ShowS
[JsonDecodeError] -> ShowS
JsonDecodeError -> String
(Int -> JsonDecodeError -> ShowS)
-> (JsonDecodeError -> String)
-> ([JsonDecodeError] -> ShowS)
-> Show JsonDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonDecodeError -> ShowS
showsPrec :: Int -> JsonDecodeError -> ShowS
$cshow :: JsonDecodeError -> String
show :: JsonDecodeError -> String
$cshowList :: [JsonDecodeError] -> ShowS
showList :: [JsonDecodeError] -> ShowS
Show)

newJsonDecodeError :: ToText a => a -> JsonDecodeError
newJsonDecodeError :: forall a. ToText a => a -> JsonDecodeError
newJsonDecodeError a
message =
  JsonDecodeError
    { message :: Text
message    = a -> Text
forall a. ToText a => a -> Text
toText a
message
    , bytestring :: Maybe ByteString
bytestring = Maybe ByteString
forall a. Maybe a
Nothing
    , text :: Maybe Text
text       = Maybe Text
forall a. Maybe a
Nothing
    , json :: Maybe Value
json       = Maybe Value
forall a. Maybe a
Nothing
    }

instance ToJSON JsonDecodeError where
  toJSON :: JsonDecodeError -> Value
toJSON JsonDecodeError
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
"JsonDecodeError"
        , Key
"message" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonDecodeError
e.message
        , Key
"text" Key -> Maybe Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonDecodeError
e.text
        , Key
"json" Key -> Maybe Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonDecodeError
e.json
        ]