{-# LANGUAGE LambdaCase #-}

module Web.Hyperbole.Server.Options where

import Data.ByteString.Lazy qualified as BL
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Web.Hyperbole.Data.Encoded (Encoded, encodedToText)
import Web.Hyperbole.Types.Event
import Web.Hyperbole.Types.Response
import Web.Hyperbole.View
import Web.Atomic.CSS


data ServerOptions = ServerOptions
  { ServerOptions -> ByteString -> ByteString
toDocument :: BL.ByteString -> BL.ByteString
  , ServerOptions -> ResponseError -> ServerError
serverError :: ResponseError -> ServerError
  }


defaultErrorMessage :: ResponseError -> Text
defaultErrorMessage :: ResponseError -> Text
defaultErrorMessage = \case
  -- mask server errors
  ErrCustom ServerError
e -> ServerError
e.message
  ResponseError
NotFound -> Text
"Not Found"
  ResponseError
ErrInternal -> Text
"Internal Server Error"
  ErrServer Text
m -> Text
m
  ResponseError
e -> [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
3 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ResponseError -> [Char]
forall a. Show a => a -> [Char]
show ResponseError
e


defaultErrorBody :: Text -> View Body ()
defaultErrorBody :: Text -> View Body ()
defaultErrorBody Text
msg =
  View Body () -> View Body ()
forall c. View c () -> View c ()
el (View Body () -> View Body ())
-> (CSS (View Body () -> View Body ())
    -> CSS (View Body () -> View Body ()))
-> View Body ()
-> View Body ()
forall h. Styleable h => h -> (CSS h -> CSS h) -> h
~ HexColor
-> CSS (View Body () -> View Body ())
-> CSS (View Body () -> View Body ())
forall clr h. (ToColor clr, Styleable h) => clr -> CSS h -> CSS h
bg (Text -> HexColor
HexColor Text
"#F00") (CSS (View Body () -> View Body ())
 -> CSS (View Body () -> View Body ()))
-> (CSS (View Body () -> View Body ())
    -> CSS (View Body () -> View Body ()))
-> CSS (View Body () -> View Body ())
-> CSS (View Body () -> View Body ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexColor
-> CSS (View Body () -> View Body ())
-> CSS (View Body () -> View Body ())
forall h clr. (Styleable h, ToColor clr) => clr -> CSS h -> CSS h
color (Text -> HexColor
HexColor Text
"#FFF") (View Body () -> View Body ()) -> View Body () -> View Body ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> View Body ()
forall c. Text -> View c ()
text Text
msg


defaultError :: ResponseError -> ServerError
defaultError :: ResponseError -> ServerError
defaultError = \case
  ErrCustom ServerError
e -> ServerError
e
  ErrNotHandled Event TargetViewId Encoded
e -> Event TargetViewId Encoded -> ServerError
errNotHandled Event TargetViewId Encoded
e
  ResponseError
err -> 
    let msg :: Text
msg = ResponseError -> Text
defaultErrorMessage ResponseError
err
    in Text -> View Body () -> ServerError
ServerError Text
msg (Text -> View Body ()
defaultErrorBody Text
msg)
 where
  errNotHandled :: Event TargetViewId Encoded -> ServerError
  errNotHandled :: Event TargetViewId Encoded -> ServerError
errNotHandled Event TargetViewId Encoded
ev =
    Text -> View Body () -> ServerError
ServerError Text
"Action Not Handled" (View Body () -> ServerError) -> View Body () -> ServerError
forall a b. (a -> b) -> a -> b
$ do
      View Body () -> View Body ()
forall c. View c () -> View c ()
el (View Body () -> View Body ()) -> View Body () -> View Body ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> View Body ()
forall c. Text -> View c ()
text Text
"No Handler for Event viewId: "
        Text -> View Body ()
forall c. Text -> View c ()
text Event TargetViewId Encoded
ev.viewId.text
        Text -> View Body ()
forall c. Text -> View c ()
text Text
" action: "
        Text -> View Body ()
forall c. Text -> View c ()
text (Text -> View Body ()) -> Text -> View Body ()
forall a b. (a -> b) -> a -> b
$ Encoded -> Text
encodedToText Event TargetViewId Encoded
ev.action
      View Body () -> View Body ()
forall c. View c () -> View c ()
el (View Body () -> View Body ()) -> View Body () -> View Body ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> View Body ()
forall c. Text -> View c ()
text Text
"Remember to add a `hyper` handler in your page function"
      Text -> View Body ()
forall c. Text -> View c ()
pre (Text -> View Body ()) -> Text -> View Body ()
forall a b. (a -> b) -> a -> b
$
        Text -> [Text] -> Text
T.intercalate
          Text
"\n"
          [ Text
"page :: (Hyperbole :> es) => Page es Response"
          , Text
"page = do"
          , Text
"  handle contentsHandler"
          , Text
"  load $ do"
          , Text
"    pure $ hyper Contents contentsView"
          , Text
"</pre>"
          ]