module Web.Hyperbole.Effect.Response where

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


-- | Respond with the given hyperview
hyperView :: (HyperView id es, ToEncoded (ViewState id)) => id -> ViewState id -> View id () -> Eff es Response
hyperView :: forall id (es :: [Effect]).
(HyperView id es, ToEncoded (ViewState id)) =>
id -> ViewState id -> View id () -> Eff es Response
hyperView id
i ViewState id
st View id ()
vw = do
  let vid :: TargetViewId
vid = Encoded -> TargetViewId
TargetViewId (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
$ ViewUpdate -> Response
Response (ViewUpdate -> Response) -> ViewUpdate -> Response
forall a b. (a -> b) -> a -> b
$ TargetViewId -> Body -> ViewUpdate
ViewUpdate TargetViewId
vid (Body -> ViewUpdate) -> Body -> ViewUpdate
forall a b. (a -> b) -> a -> b
$ View () () -> Body
renderBody (View () () -> Body) -> View () () -> Body
forall a b. (a -> b) -> a -> b
$ id -> ViewState id -> View id () -> View () ()
forall id ctx.
(ViewId id, ViewState id ~ ViewState id, ToEncoded (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperUnsafe id
i ViewState id
st View id ()
vw


pushUpdate :: (Hyperbole :> es, ViewId id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id)) => View id () -> Eff (Reader id : State (ViewState id) : es) ()
pushUpdate :: forall (es :: [Effect]) id.
(Hyperbole :> es, ViewId id, ToEncoded (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
View id () -> Eff (Reader id : State (ViewState id) : es) ()
pushUpdate View id ()
vw = do
  id
i <- Eff (Reader id : State (ViewState id) : es) id
forall {k} (m :: k -> *) (view :: k). HasViewId m view => m view
viewId
  ViewState id
st <- Eff (Reader id : State (ViewState id) : es) (ViewState id)
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
Eff es s
get
  id
-> ViewState id
-> View id ()
-> Eff (Reader id : State (ViewState id) : es) ()
forall (es :: [Effect]) id.
(Hyperbole :> es, ViewId id, ToEncoded (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> Eff es ()
pushUpdateTo id
i ViewState id
st View id ()
vw


pushUpdateTo :: (Hyperbole :> es, ViewId id, ToEncoded (ViewState id), ConcurrencyValue (Concurrency id)) => id -> ViewState id -> View id () -> Eff es ()
pushUpdateTo :: forall (es :: [Effect]) id.
(Hyperbole :> es, ViewId id, ToEncoded (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> Eff es ()
pushUpdateTo id
i ViewState id
st View id ()
vw = do
  Hyperbole (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) () -> Eff es ())
-> Hyperbole (Eff es) () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ ViewUpdate -> Hyperbole (Eff es) ()
forall (a :: * -> *). ViewUpdate -> Hyperbole a ()
PushUpdate (ViewUpdate -> Hyperbole (Eff es) ())
-> ViewUpdate -> Hyperbole (Eff es) ()
forall a b. (a -> b) -> a -> b
$ TargetViewId -> Body -> ViewUpdate
ViewUpdate (Encoded -> TargetViewId
TargetViewId (Encoded -> TargetViewId) -> Encoded -> TargetViewId
forall a b. (a -> b) -> a -> b
$ id -> Encoded
forall a. ViewId a => a -> Encoded
toViewId id
i) (Body -> ViewUpdate) -> Body -> ViewUpdate
forall a b. (a -> b) -> a -> b
$ View () () -> Body
renderBody (View () () -> Body) -> View () () -> Body
forall a b. (a -> b) -> a -> b
$ id -> ViewState id -> View id () -> View () ()
forall id ctx.
(ViewId id, ViewState id ~ ViewState id, ToEncoded (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperUnsafe id
i ViewState id
st 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 () () -> Eff es a
respondErrorView :: forall (es :: [Effect]) a.
(Hyperbole :> es) =>
Text -> View () () -> Eff es a
respondErrorView Text
msg View () ()
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 -> Body -> ServerError
ServerError Text
msg (Body -> ServerError) -> Body -> ServerError
forall a b. (a -> b) -> a -> b
$ View () () -> Body
renderBody View () ()
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 () () -> Response
view :: View () () -> Response
view View () ()
v =
  ViewUpdate -> Response
Response (ViewUpdate -> Response) -> ViewUpdate -> Response
forall a b. (a -> b) -> a -> b
$ TargetViewId -> Body -> ViewUpdate
ViewUpdate (Encoded -> TargetViewId
TargetViewId Encoded
forall a. Monoid a => a
mempty) (View () () -> Body
renderBody View () ()
v)