{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.Server.Handler where

import Data.Kind (Type)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Reader.Dynamic
import Web.Hyperbole.Data.Encoded
import Web.Hyperbole.Effect.Hyperbole
import Web.Hyperbole.Effect.Response (hyperView, respondError)
import Web.Hyperbole.HyperView
import Web.Hyperbole.Types.Event
import Web.Hyperbole.Types.Request
import Web.Hyperbole.Types.Response
import Web.Hyperbole.View


class RunHandlers (views :: [Type]) es where
  runHandlers :: (Hyperbole :> es) => Event TargetViewId Encoded -> Eff es (Maybe Response)


instance RunHandlers '[] es where
  runHandlers :: (Hyperbole :> es) =>
Event TargetViewId Encoded -> Eff es (Maybe Response)
runHandlers Event TargetViewId Encoded
_ = Maybe Response -> Eff es (Maybe Response)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Response
forall a. Maybe a
Nothing


instance (HyperView view es, RunHandlers views es) => RunHandlers (view : views) es where
  runHandlers :: (Hyperbole :> es) =>
Event TargetViewId Encoded -> Eff es (Maybe Response)
runHandlers Event TargetViewId Encoded
rawEvent = do
    Maybe Response
mr <- forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Event TargetViewId Encoded
-> (Action id -> Eff (Reader id : es) (View id ()))
-> Eff es (Maybe Response)
runHandler @view Event TargetViewId Encoded
rawEvent (forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Action id -> Eff (Reader id : es) (View id ())
update @view)
    case Maybe Response
mr of
      Maybe Response
Nothing -> forall (views :: [*]) (es :: [Effect]).
(RunHandlers views es, Hyperbole :> es) =>
Event TargetViewId Encoded -> Eff es (Maybe Response)
runHandlers @views Event TargetViewId Encoded
rawEvent
      Just Response
r -> Maybe Response -> Eff es (Maybe Response)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Maybe Response
forall a. a -> Maybe a
Just Response
r)


runHandler
  :: forall id es
   . (HyperView id es, Hyperbole :> es)
  => Event TargetViewId Encoded
  -> (Action id -> Eff (Reader id : es) (View id ()))
  -> Eff es (Maybe Response)
runHandler :: forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Event TargetViewId Encoded
-> (Action id -> Eff (Reader id : es) (View id ()))
-> Eff es (Maybe Response)
runHandler Event TargetViewId Encoded
rawEvent Action id -> Eff (Reader id : es) (View id ())
run = do
  -- Get an event matching our type. If it doesn't match, skip to the next handler
  Maybe (Event id (Action id))
mev <- forall id (es :: [Effect]).
HyperView id es =>
Event TargetViewId Encoded -> Eff es (Maybe (Event id (Action id)))
decodeEvent @id Event TargetViewId Encoded
rawEvent :: Eff es (Maybe (Event id (Action id)))
  case Maybe (Event id (Action id))
mev of
    Just Event id (Action id)
evt -> do
      View id ()
vw <- id -> Eff (Reader id : es) (View id ()) -> Eff es (View id ())
forall r (es :: [Effect]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader Event id (Action id)
evt.viewId (Eff (Reader id : es) (View id ()) -> Eff es (View id ()))
-> Eff (Reader id : es) (View id ()) -> Eff es (View id ())
forall a b. (a -> b) -> a -> b
$ Action id -> Eff (Reader id : es) (View id ())
run Event id (Action id)
evt.action
      Response
res <- id -> View id () -> Eff es Response
forall id (es :: [Effect]).
HyperView id es =>
id -> View id () -> Eff es Response
hyperView Event id (Action id)
evt.viewId View id ()
vw
      Maybe Response -> Eff es (Maybe Response)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Response -> Eff es (Maybe Response))
-> Maybe Response -> Eff es (Maybe Response)
forall a b. (a -> b) -> a -> b
$ Response -> Maybe Response
forall a. a -> Maybe a
Just Response
res
    Maybe (Event id (Action id))
_ -> do
      Maybe Response -> Eff es (Maybe Response)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Response
forall a. Maybe a
Nothing


runLoad
  :: forall views es
   . (Hyperbole :> es, RunHandlers views es)
  => Eff es (View (Root views) ())
  -> Eff es Response
runLoad :: forall (views :: [*]) (es :: [Effect]).
(Hyperbole :> es, RunHandlers views es) =>
Eff es (View (Root views) ()) -> Eff es Response
runLoad Eff es (View (Root views) ())
page = do
  Maybe (Event TargetViewId Encoded)
ev <- (.event) (Request -> Maybe (Event TargetViewId Encoded))
-> Eff es Request -> Eff es (Maybe (Event TargetViewId Encoded))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hyperbole (Eff es) Request -> Eff es Request
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Hyperbole (Eff es) Request
forall (a :: * -> *). Hyperbole a Request
GetRequest
  case Maybe (Event TargetViewId Encoded)
ev of
    Just Event TargetViewId Encoded
rawEvent -> do
      Maybe Response
res <- forall (views :: [*]) (es :: [Effect]).
(RunHandlers views es, Hyperbole :> es) =>
Event TargetViewId Encoded -> Eff es (Maybe Response)
runHandlers @views Event TargetViewId Encoded
rawEvent
      case Maybe Response
res of
        -- if we found an event, it should have been handled by one of the views
        Maybe Response
Nothing -> ResponseError -> Eff es Response
forall (es :: [Effect]) a.
(Hyperbole :> es) =>
ResponseError -> Eff es a
respondError (ResponseError -> Eff es Response)
-> ResponseError -> Eff es Response
forall a b. (a -> b) -> a -> b
$ Event TargetViewId Encoded -> ResponseError
ErrNotHandled Event TargetViewId Encoded
rawEvent
        Just Response
r -> Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
r
    Maybe (Event TargetViewId Encoded)
Nothing -> do
      Eff es (View (Root views) ()) -> Eff es Response
forall (es :: [Effect]) (total :: [*]).
Eff es (View (Root total) ()) -> Eff es Response
loadPageResponse Eff es (View (Root views) ())
page


loadPageResponse :: Eff es (View (Root total) ()) -> Eff es Response
loadPageResponse :: forall (es :: [Effect]) (total :: [*]).
Eff es (View (Root total) ()) -> Eff es Response
loadPageResponse Eff es (View (Root total) ())
run = do
  View (Root total) ()
vw <- Eff es (View (Root total) ())
run
  let vid :: TargetViewId
vid = Text -> TargetViewId
TargetViewId (Encoded -> Text
encodedToText (Encoded -> Text) -> Encoded -> Text
forall a b. (a -> b) -> a -> b
$ Root Any -> Encoded
forall a. ViewId a => a -> Encoded
toViewId Root Any
forall (views :: [*]). Root views
Root)
  let res :: Response
res = TargetViewId -> View Body () -> Response
Response TargetViewId
vid (View Body () -> Response) -> View Body () -> Response
forall a b. (a -> b) -> a -> b
$ Root total -> View (Root total) () -> View Body ()
forall ctx c. ctx -> View ctx () -> View c ()
addContext Root total
forall (views :: [*]). Root views
Root View (Root total) ()
vw
  Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res


-- despite not needing any effects, this must be in Eff es to get `es` on the RHS
decodeEvent :: forall id es. (HyperView id es) => Event TargetViewId Encoded -> Eff es (Maybe (Event id (Action id)))
decodeEvent :: forall id (es :: [Effect]).
HyperView id es =>
Event TargetViewId Encoded -> Eff es (Maybe (Event id (Action id)))
decodeEvent (Event (TargetViewId Text
ti) Encoded
eact) =
  Maybe (Event id (Action id))
-> Eff es (Maybe (Event id (Action id)))
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Event id (Action id))
 -> Eff es (Maybe (Event id (Action id))))
-> Maybe (Event id (Action id))
-> Eff es (Maybe (Event id (Action id)))
forall a b. (a -> b) -> a -> b
$ do
    id
vid <- Text -> Maybe id
forall id. ViewId id => Text -> Maybe id
decodeViewId Text
ti
    Action id
act <- (String -> Maybe (Action id))
-> (Action id -> Maybe (Action id))
-> Either String (Action id)
-> Maybe (Action id)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Action id) -> String -> Maybe (Action id)
forall a b. a -> b -> a
const Maybe (Action id)
forall a. Maybe a
Nothing) Action id -> Maybe (Action id)
forall a. a -> Maybe a
Just (Either String (Action id) -> Maybe (Action id))
-> Either String (Action id) -> Maybe (Action id)
forall a b. (a -> b) -> a -> b
$ Encoded -> Either String (Action id)
forall a. ViewAction a => Encoded -> Either String a
parseAction Encoded
eact
    Event id (Action id) -> Maybe (Event id (Action id))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event id (Action id) -> Maybe (Event id (Action id)))
-> Event id (Action id) -> Maybe (Event id (Action id))
forall a b. (a -> b) -> a -> b
$ id -> Action id -> Event id (Action id)
forall id act. id -> act -> Event id act
Event id
vid Action id
act