{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module HaskellWorks.Error.Types.GenericError (
    GenericError (..),
) where

import           Data.Aeson
import           Data.Generics.Product.Any
import           HaskellWorks.Error.Types.RenderedError
import           Lens.Micro

import           HaskellWorks.Prelude

newtype GenericError = GenericError
    { GenericError -> Text
message :: Text
    }
    deriving (GenericError -> GenericError -> Bool
(GenericError -> GenericError -> Bool)
-> (GenericError -> GenericError -> Bool) -> Eq GenericError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenericError -> GenericError -> Bool
== :: GenericError -> GenericError -> Bool
$c/= :: GenericError -> GenericError -> Bool
/= :: GenericError -> GenericError -> Bool
Eq, (forall x. GenericError -> Rep GenericError x)
-> (forall x. Rep GenericError x -> GenericError)
-> Generic GenericError
forall x. Rep GenericError x -> GenericError
forall x. GenericError -> Rep GenericError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenericError -> Rep GenericError x
from :: forall x. GenericError -> Rep GenericError x
$cto :: forall x. Rep GenericError x -> GenericError
to :: forall x. Rep GenericError x -> GenericError
Generic, Int -> GenericError -> ShowS
[GenericError] -> ShowS
GenericError -> String
(Int -> GenericError -> ShowS)
-> (GenericError -> String)
-> ([GenericError] -> ShowS)
-> Show GenericError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenericError -> ShowS
showsPrec :: Int -> GenericError -> ShowS
$cshow :: GenericError -> String
show :: GenericError -> String
$cshowList :: [GenericError] -> ShowS
showList :: [GenericError] -> ShowS
Show)

instance ToRenderedError GenericError where
    toRenderedError :: GenericError -> RenderedError
toRenderedError GenericError
e =
        RenderedError
            { $sel:error:RenderedError :: Text
error   = Text
"GenericError"
            , $sel:payload:RenderedError :: Value
payload = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ GenericError
e GenericError -> Getting Text GenericError Text -> Text
forall s a. s -> Getting a s a -> a
^. forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"message"
            }