{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.Types.Response where

import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Web.Hyperbole.Data.Encoded (Encoded)
import Web.Hyperbole.Data.URI (URI)
import Web.Hyperbole.Types.Event
import Web.Hyperbole.View


data Body = Body


-- | A processed response for the client, which might be a 'ResponseError'
data Response
  = Response TargetViewId (View Body ())
  | Redirect URI
  | Err ResponseError


data ResponseError
  = NotFound
  | ErrParse String
  | ErrQuery String
  | ErrSession Text String
  | ErrServer Text
  | ErrCustom ServerError
  | ErrInternal
  | ErrNotHandled (Event TargetViewId Encoded)
  | ErrAuth Text
instance Show ResponseError where
  show :: ResponseError -> String
show = \case
    ResponseError
NotFound -> String
"NotFound"
    ErrParse String
m -> String
"ErrParse " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertibleStrings a b => a -> b
cs String
m
    ErrQuery String
m -> String
"ErrQuery " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertibleStrings a b => a -> b
cs String
m
    ErrSession Text
k String
m -> String
"ErrSession " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertibleStrings a b => a -> b
cs String
m
    ErrServer Text
m -> String
"ErrServer " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
m
    ErrCustom ServerError
err -> String
"ErrCustom " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs ServerError
err.message
    ResponseError
ErrInternal -> String
"ErrInternal"
    ErrNotHandled Event TargetViewId Encoded
ev -> String
"ErrNotHandled " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Event TargetViewId Encoded -> String
forall a. Show a => a -> String
show Event TargetViewId Encoded
ev
    ErrAuth Text
m -> String
"ErrAuth " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
m
instance IsString ResponseError where
  fromString :: String -> ResponseError
fromString String
s = Text -> ResponseError
ErrServer (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
s)


-- Serialized server error
data ServerError = ServerError
  { ServerError -> Text
message :: Text
  , ServerError -> View Body ()
body :: View Body ()
  }