module Web.Hyperbole.Effect.Response where

import Data.Text (Text)
import Effectful
import Effectful.Dispatch.Dynamic
import Web.Hyperbole.Data.Encoded
import Web.Hyperbole.Data.URI
import Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))
import Web.Hyperbole.HyperView (HyperView (..), ViewId (..), hyperUnsafe)
import Web.Hyperbole.Types.Event
import Web.Hyperbole.Types.Response
import Web.Hyperbole.View.Types


-- | Respond with the given hyperview
hyperView :: (HyperView id es) => id -> View id () -> Eff es Response
hyperView :: forall id (es :: [Effect]).
HyperView id es =>
id -> View id () -> Eff es Response
hyperView id
i View id ()
vw = do
  let vid :: TargetViewId
vid = Text -> TargetViewId
TargetViewId (Encoded -> Text
encodedToText (Encoded -> Text) -> Encoded -> Text
forall a b. (a -> b) -> a -> b
$ id -> Encoded
forall a. ViewId a => a -> Encoded
toViewId id
i)
  Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Eff es Response) -> Response -> Eff es Response
forall a b. (a -> b) -> a -> b
$ TargetViewId -> View Body () -> Response
Response TargetViewId
vid (View Body () -> Response) -> View Body () -> Response
forall a b. (a -> b) -> a -> b
$ id -> View id () -> View Body ()
forall id ctx. ViewId id => id -> View id () -> View ctx ()
hyperUnsafe id
i View id ()
vw


-- | Abort execution and respond with an error
respondError :: (Hyperbole :> es) => ResponseError -> Eff es a
respondError :: forall (es :: [Effect]) a.
(Hyperbole :> es) =>
ResponseError -> Eff es a
respondError ResponseError
err = do
  Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> Hyperbole (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> Response -> Hyperbole (Eff es) a
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err ResponseError
err


-- | Abort execution and respond with an error view
respondErrorView :: (Hyperbole :> es) => Text -> View Body () -> Eff es a
respondErrorView :: forall (es :: [Effect]) a.
(Hyperbole :> es) =>
Text -> View Body () -> Eff es a
respondErrorView Text
msg View Body ()
vw = do
  Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> Hyperbole (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> Response -> Hyperbole (Eff es) a
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err (ResponseError -> Response) -> ResponseError -> Response
forall a b. (a -> b) -> a -> b
$ ServerError -> ResponseError
ErrCustom (ServerError -> ResponseError) -> ServerError -> ResponseError
forall a b. (a -> b) -> a -> b
$ Text -> View Body () -> ServerError
ServerError Text
msg View Body ()
vw


{- | Abort execution and respond with 404 Not Found

@
findUser :: ('Hyperbole' :> es, Users :> es) => Int -> 'Eff' es User
findUser uid = do
  mu <- send (LoadUser uid)
  maybe notFound pure mu

userPage :: ('Hyperbole' :> es, Users :> es) => 'Page' es '[]
userPage = do
  user <- findUser 100

  -- skipped if user not found
  pure $ userView user
@
-}
notFound :: (Hyperbole :> es) => Eff es a
notFound :: forall (es :: [Effect]) a. (Hyperbole :> es) => Eff es a
notFound = Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> Hyperbole (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> Response -> Hyperbole (Eff es) a
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err ResponseError
NotFound


-- | Respond immediately with a parse error
parseError :: (Hyperbole :> es) => String -> Eff es a
parseError :: forall (es :: [Effect]) a. (Hyperbole :> es) => String -> Eff es a
parseError = ResponseError -> Eff es a
forall (es :: [Effect]) a.
(Hyperbole :> es) =>
ResponseError -> Eff es a
respondError (ResponseError -> Eff es a)
-> (String -> ResponseError) -> String -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ResponseError
ErrParse


-- | Abort execution and redirect to a 'URI'
redirect :: (Hyperbole :> es) => URI -> Eff es a
redirect :: forall (es :: [Effect]) a. (Hyperbole :> es) => URI -> Eff es a
redirect = Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> (URI -> Hyperbole (Eff es) a) -> URI -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> (URI -> Response) -> URI -> Hyperbole (Eff es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Response
Redirect


-- | Respond with a generic view. Normally you will return a view from the page or handler instead of using this function
view :: View Body () -> Response
view :: View Body () -> Response
view =
  TargetViewId -> View Body () -> Response
Response (Text -> TargetViewId
TargetViewId Text
"")