module Network.Wai.Middleware.ProblemDetails.Internal.Types
(
    ProblemDetails
  , setType
  , setTitle
  , title
  , setDetail
  , setInstance
  , setExtensions
  , setStatus
  , status
)
where

import           Data.Aeson     (Value)
import           Data.Default
import           Data.Text      (Text)
import qualified Data.Text      as T
import           Deriving.Aeson
import           Network.URI    (URI)

-- | The problem details data type.
data ProblemDetails = ProblemDetails
  { ProblemDetails -> Maybe Text
pdType       :: !(Maybe Text)       -- ^ 'about:blank' when not present. This URI, when specified, should resolve to an HTML resource.
  , ProblemDetails -> Maybe Text
pdTitle      :: !(Maybe Text)
  , ProblemDetails -> Maybe Int
pdStatus     :: !(Maybe Int)
  , ProblemDetails -> Maybe Text
pdDetail     :: !(Maybe Text)
  , ProblemDetails -> Maybe Text
pdInstance   :: !(Maybe Text)       -- ^ Identifies a specific occurrence of the problem.
  , ProblemDetails -> Maybe Value
pdExtensions :: !(Maybe Value)
  }
  deriving stock (Int -> ProblemDetails -> ShowS
[ProblemDetails] -> ShowS
ProblemDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemDetails] -> ShowS
$cshowList :: [ProblemDetails] -> ShowS
show :: ProblemDetails -> String
$cshow :: ProblemDetails -> String
showsPrec :: Int -> ProblemDetails -> ShowS
$cshowsPrec :: Int -> ProblemDetails -> ShowS
Show, forall x. Rep ProblemDetails x -> ProblemDetails
forall x. ProblemDetails -> Rep ProblemDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProblemDetails x -> ProblemDetails
$cfrom :: forall x. ProblemDetails -> Rep ProblemDetails x
Generic)
  deriving ([ProblemDetails] -> Encoding
[ProblemDetails] -> Value
ProblemDetails -> Encoding
ProblemDetails -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProblemDetails] -> Encoding
$ctoEncodingList :: [ProblemDetails] -> Encoding
toJSONList :: [ProblemDetails] -> Value
$ctoJSONList :: [ProblemDetails] -> Value
toEncoding :: ProblemDetails -> Encoding
$ctoEncoding :: ProblemDetails -> Encoding
toJSON :: ProblemDetails -> Value
$ctoJSON :: ProblemDetails -> Value
ToJSON)
  via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "pd", CamelToSnake]] ProblemDetails

instance Default ProblemDetails where
  def :: ProblemDetails
def = Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Value
-> ProblemDetails
ProblemDetails forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | 'status' return the status for this 'ProblemDetails'
status :: ProblemDetails -> Maybe Int
status :: ProblemDetails -> Maybe Int
status = ProblemDetails -> Maybe Int
pdStatus

-- | 'setType' sets the type field of the problem details object.
setType :: URI -> ProblemDetails -> ProblemDetails
setType :: URI -> ProblemDetails -> ProblemDetails
setType URI
uri ProblemDetails
pd = ProblemDetails
pd {pdType :: Maybe Text
pdType = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show URI
uri}

-- | 'setStatus' sets the status field of the problem details object.
setStatus :: Int -> ProblemDetails -> ProblemDetails
setStatus :: Int -> ProblemDetails -> ProblemDetails
setStatus Int
status ProblemDetails
pd = ProblemDetails
pd {pdStatus :: Maybe Int
pdStatus = forall a. a -> Maybe a
Just Int
status}

-- | 'title' return the title for this 'ProblemDetails'
title :: ProblemDetails -> Maybe Text
title :: ProblemDetails -> Maybe Text
title = ProblemDetails -> Maybe Text
pdTitle

-- | 'setTitle' sets the title field of the problem details object.
setTitle :: Text -> ProblemDetails -> ProblemDetails
setTitle :: Text -> ProblemDetails -> ProblemDetails
setTitle Text
title ProblemDetails
pd = ProblemDetails
pd {pdTitle :: Maybe Text
pdTitle = forall a. a -> Maybe a
Just Text
title}

-- | 'setDetail' sets the detail field of the problem details object.
setDetail :: Text -> ProblemDetails -> ProblemDetails
setDetail :: Text -> ProblemDetails -> ProblemDetails
setDetail Text
detail ProblemDetails
pd = ProblemDetails
pd {pdDetail :: Maybe Text
pdDetail = forall a. a -> Maybe a
Just Text
detail}

-- | 'setInstance' sets the instance field of the problem details object.
setInstance :: URI -> ProblemDetails -> ProblemDetails
setInstance :: URI -> ProblemDetails -> ProblemDetails
setInstance URI
inst ProblemDetails
pd = ProblemDetails
pd {pdInstance :: Maybe Text
pdInstance = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show URI
inst}

-- | 'setExtensions' adds the provided extensions to the problem details object.
setExtensions :: Value -> ProblemDetails -> ProblemDetails
setExtensions :: Value -> ProblemDetails -> ProblemDetails
setExtensions Value
exts ProblemDetails
pd = ProblemDetails
pd {pdExtensions :: Maybe Value
pdExtensions = forall a. a -> Maybe a
Just Value
exts}