{-# 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 Effectful.State.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 Encoded -> Eff es (Maybe Response)


instance RunHandlers '[] es where
  runHandlers :: (Hyperbole :> es) =>
Event TargetViewId Encoded Encoded -> Eff es (Maybe Response)
runHandlers Event TargetViewId Encoded 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, ToEncoded (ViewState view), FromEncoded (ViewState view), RunHandlers views es) => RunHandlers (view : views) es where
  runHandlers :: (Hyperbole :> es) =>
Event TargetViewId Encoded Encoded -> Eff es (Maybe Response)
runHandlers Event TargetViewId Encoded Encoded
rawEvent = do
    Maybe Response
mr <- forall id (es :: [Effect]).
(HyperView id es, ToEncoded (ViewState id),
 FromEncoded (ViewState id), Hyperbole :> es) =>
Event TargetViewId Encoded Encoded
-> (Action id
    -> Eff (Reader id : State (ViewState id) : es) (View id ()))
-> Eff es (Maybe Response)
runHandler @view Event TargetViewId Encoded Encoded
rawEvent (forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Action id
-> Eff (Reader id : State (ViewState 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 Encoded -> Eff es (Maybe Response)
runHandlers @views Event TargetViewId Encoded 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, ToEncoded (ViewState id), FromEncoded (ViewState id), Hyperbole :> es)
  => Event TargetViewId Encoded Encoded
  -> (Action id -> Eff (Reader id : State (ViewState id) : es) (View id ()))
  -> Eff es (Maybe Response)
runHandler :: forall id (es :: [Effect]).
(HyperView id es, ToEncoded (ViewState id),
 FromEncoded (ViewState id), Hyperbole :> es) =>
Event TargetViewId Encoded Encoded
-> (Action id
    -> Eff (Reader id : State (ViewState id) : es) (View id ()))
-> Eff es (Maybe Response)
runHandler Event TargetViewId Encoded Encoded
rawEvent Action id
-> Eff (Reader id : State (ViewState 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) (ViewState id))
mev <- forall id (es :: [Effect]).
(HyperView id es, FromEncoded (ViewState id)) =>
Event TargetViewId Encoded Encoded
-> Eff es (Maybe (Event id (Action id) (ViewState id)))
decodeEvent @id Event TargetViewId Encoded Encoded
rawEvent :: Eff es (Maybe (Event id (Action id) (ViewState id)))
  case Maybe (Event id (Action id) (ViewState id))
mev of
    Just Event id (Action id) (ViewState id)
evt -> do
      (View id ()
vw, ViewState id
st) <- ViewState id
-> Eff (State (ViewState id) : es) (View id ())
-> Eff es (View id (), ViewState id)
forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runStateLocal Event id (Action id) (ViewState id)
evt.state (Eff (State (ViewState id) : es) (View id ())
 -> Eff es (View id (), ViewState id))
-> Eff (State (ViewState id) : es) (View id ())
-> Eff es (View id (), ViewState id)
forall a b. (a -> b) -> a -> b
$ id
-> Eff (Reader id : State (ViewState id) : es) (View id ())
-> Eff (State (ViewState id) : es) (View id ())
forall r (es :: [Effect]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader Event id (Action id) (ViewState id)
evt.viewId (Eff (Reader id : State (ViewState id) : es) (View id ())
 -> Eff (State (ViewState id) : es) (View id ()))
-> Eff (Reader id : State (ViewState id) : es) (View id ())
-> Eff (State (ViewState id) : es) (View id ())
forall a b. (a -> b) -> a -> b
$ Action id
-> Eff (Reader id : State (ViewState id) : es) (View id ())
run Event id (Action id) (ViewState id)
evt.action
      Response
res <- id -> ViewState id -> View id () -> Eff es Response
forall id (es :: [Effect]).
(HyperView id es, ToEncoded (ViewState id)) =>
id -> ViewState id -> View id () -> Eff es Response
hyperView Event id (Action id) (ViewState id)
evt.viewId ViewState id
st 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) (ViewState 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 Encoded)
ev <- (.event) (Request -> Maybe (Event TargetViewId Encoded Encoded))
-> Eff es Request
-> Eff es (Maybe (Event TargetViewId Encoded 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 Encoded)
ev of
    Just Event TargetViewId Encoded Encoded
rawEvent -> do
      Maybe Response
res <- forall (views :: [*]) (es :: [Effect]).
(RunHandlers views es, Hyperbole :> es) =>
Event TargetViewId Encoded Encoded -> Eff es (Maybe Response)
runHandlers @views Event TargetViewId Encoded 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 Encoded -> ResponseError
ErrNotHandled Event TargetViewId Encoded 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 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 = Encoded -> TargetViewId
TargetViewId (Encoded -> TargetViewId) -> Encoded -> TargetViewId
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 = 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
$ Root total
-> ViewState (Root total) -> View (Root total) () -> View () ()
forall ctx c. ctx -> ViewState ctx -> View ctx () -> View c ()
runViewContext 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, FromEncoded (ViewState id)) => Event TargetViewId Encoded Encoded -> Eff es (Maybe (Event id (Action id) (ViewState id)))
decodeEvent :: forall id (es :: [Effect]).
(HyperView id es, FromEncoded (ViewState id)) =>
Event TargetViewId Encoded Encoded
-> Eff es (Maybe (Event id (Action id) (ViewState id)))
decodeEvent (Event (TargetViewId Encoded
ti) Encoded
eact Encoded
est) =
  Maybe (Event id (Action id) (ViewState id))
-> Eff es (Maybe (Event id (Action id) (ViewState id)))
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Event id (Action id) (ViewState id))
 -> Eff es (Maybe (Event id (Action id) (ViewState id))))
-> Maybe (Event id (Action id) (ViewState id))
-> Eff es (Maybe (Event id (Action id) (ViewState id)))
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (Event id (Action id) (ViewState id)))
-> (Event id (Action id) (ViewState id)
    -> Maybe (Event id (Action id) (ViewState id)))
-> Either String (Event id (Action id) (ViewState id))
-> Maybe (Event id (Action id) (ViewState id))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Event id (Action id) (ViewState id))
-> String -> Maybe (Event id (Action id) (ViewState id))
forall a b. a -> b -> a
const Maybe (Event id (Action id) (ViewState id))
forall a. Maybe a
Nothing) Event id (Action id) (ViewState id)
-> Maybe (Event id (Action id) (ViewState id))
forall a. a -> Maybe a
Just (Either String (Event id (Action id) (ViewState id))
 -> Maybe (Event id (Action id) (ViewState id)))
-> Either String (Event id (Action id) (ViewState id))
-> Maybe (Event id (Action id) (ViewState id))
forall a b. (a -> b) -> a -> b
$ do
    id
vid <- Encoded -> Either String id
forall a. ViewId a => Encoded -> Either String a
parseViewId Encoded
ti
    Action id
act <- Encoded -> Either String (Action id)
forall a. ViewAction a => Encoded -> Either String a
parseAction Encoded
eact
    ViewState id
st <- Encoded -> Either String (ViewState id)
forall a. FromEncoded a => Encoded -> Either String a
parseEncoded Encoded
est
    Event id (Action id) (ViewState id)
-> Either String (Event id (Action id) (ViewState id))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event id (Action id) (ViewState id)
 -> Either String (Event id (Action id) (ViewState id)))
-> Event id (Action id) (ViewState id)
-> Either String (Event id (Action id) (ViewState id))
forall a b. (a -> b) -> a -> b
$ id
-> Action id -> ViewState id -> Event id (Action id) (ViewState id)
forall id act st. id -> act -> st -> Event id act st
Event id
vid Action id
act ViewState id
st