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

module Web.Hyperbole.Effect.Handler where

import Data.Kind (Type)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Reader.Dynamic
import Web.Hyperbole.Effect.Event (getEvent, lookupEvent)
import Web.Hyperbole.Effect.Hyperbole
import Web.Hyperbole.Effect.Request (request)
import Web.Hyperbole.Effect.Respond (respondEarly)
import Web.Hyperbole.Effect.Server
import Web.Hyperbole.HyperView
import Web.View


class RunHandlers (views :: [Type]) es where
  runHandlers :: (Hyperbole :> es) => Eff es ()


instance RunHandlers '[] es where
  runHandlers :: (Hyperbole :> es) => Eff es ()
runHandlers = () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


instance (HyperView view es, RunHandlers views es) => RunHandlers (view : views) es where
  runHandlers :: (Hyperbole :> es) => Eff es ()
runHandlers = do
    forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
(Action id -> Eff (Reader id : es) (View id ())) -> Eff es ()
runHandler @view (forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Action id -> Eff (Reader id : es) (View id ())
update @view)
    forall (views :: [*]) (es :: [Effect]).
(RunHandlers views es, Hyperbole :> es) =>
Eff es ()
runHandlers @views


runHandler
  :: forall id es
   . (HyperView id es, Hyperbole :> es)
  => (Action id -> Eff (Reader id : es) (View id ()))
  -> Eff es ()
runHandler :: forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
(Action id -> Eff (Reader id : es) (View id ())) -> Eff es ()
runHandler 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, Hyperbole :> es) =>
Eff es (Maybe (Event id (Action id)))
getEvent @id :: Eff es (Maybe (Event id (Action id)))
  case Maybe (Event id (Action id))
mev of
    Just Event id (Action id)
event -> 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)
event.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)
event.action
      id -> View id () -> Eff es ()
forall (es :: [Effect]) id.
(Hyperbole :> es, HyperView id es) =>
id -> View id () -> Eff es ()
respondEarly Event id (Action id)
event.viewId View id ()
vw
    Maybe (Event id (Action id))
_ -> do
      () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


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) ())
loadPage = do
  forall (views :: [*]) (es :: [Effect]).
(RunHandlers views es, Hyperbole :> es) =>
Eff es ()
runHandlers @views
  Eff es ()
forall (es :: [Effect]). (Hyperbole :> es) => Eff es ()
guardNoEvent
  Eff es (View (Root views) ()) -> Eff es Response
forall (es :: [Effect]) (total :: [*]).
Eff es (View (Root total) ()) -> Eff es Response
loadToResponse Eff es (View (Root views) ())
loadPage


guardNoEvent :: (Hyperbole :> es) => Eff es ()
guardNoEvent :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es ()
guardNoEvent = do
  Request
r <- Eff es Request
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Request
request
  case QueryText -> Maybe (Event Text Text)
lookupEvent Request
r.query of
    -- Are id and action set to something?
    Just Event Text Text
e -> 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
$ Response -> Hyperbole (Eff es) ()
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondEarly (Response -> Hyperbole (Eff es) ())
-> Response -> Hyperbole (Eff es) ()
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err (ResponseError -> Response) -> ResponseError -> Response
forall a b. (a -> b) -> a -> b
$ Event Text Text -> ResponseError
ErrNotHandled Event Text Text
e
    Maybe (Event Text Text)
Nothing -> () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


loadToResponse :: Eff es (View (Root total) ()) -> Eff es Response
loadToResponse :: forall (es :: [Effect]) (total :: [*]).
Eff es (View (Root total) ()) -> Eff es Response
loadToResponse Eff es (View (Root total) ())
run = do
  View (Root total) ()
vw <- Eff es (View (Root total) ())
run
  let vid :: TargetViewId
vid = Text -> TargetViewId
TargetViewId (Root Any -> Text
forall a. ViewId a => a -> Text
toViewId Root Any
forall (views :: [*]). Root views
Root)
  let res :: Response
res = TargetViewId -> View () () -> Response
Response TargetViewId
vid (View () () -> Response) -> View () () -> Response
forall a b. (a -> b) -> a -> b
$ Root total -> View (Root total) () -> View () ()
forall context c. context -> View context () -> 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


-- deriving newtype (Applicative, Monad, Functor)

{- | The load handler is run when the page is first loaded. Run any side effects needed, then return a view of the full page

@
myPage :: (Hyperbole :> es) => UserId -> Page es Response
myPage userId = do
  'load' $ do
    user <- loadUserFromDatabase userId
    pure $ userPageView user
@
-}

-- load
--   :: (Hyperbole :> es)
--   => Eff es (View (Root views) ())
--   -> Page views es Response
-- load run = Page $ do
--   r <- request
--   case lookupEvent r.query of
--     -- Are id and action set to sometjhing?
--     Just e ->
--       pure $ Err $ ErrNotHandled e
--     Nothing -> do
--       vw <- run
--       view vw

{- | A handler is run when an action for that 'HyperView' is triggered. Run any side effects needed, then return a view of the corresponding type

@
myPage :: ('Hyperbole' :> es) => 'Page' es 'Response'
myPage = do
  'handle' messages
  'load' pageView

messages :: ('Hyperbole' :> es, MessageDatabase) => Message -> MessageAction -> 'Eff' es ('View' Message ())
messages (Message mid) ClearMessage = do
  deleteMessageSideEffect mid
  pure $ messageView ""

messages (Message mid) (Louder m) = do
  let new = m <> "!"
  saveMessageSideEffect mid new
  pure $ messageView new
@
-}

{- | Hyperbole applications are divided into Pages. Each Page must 'load' the whole page , and 'handle' each /type/ of 'HyperView'

@
myPage :: ('Hyperbole' :> es) => 'Page' es 'Response'
myPage = do
  'handle' messages
  'load' pageView

pageView = do
  el_ "My Page"
  'hyper' (Message 1) $ messageView "Starting Message"
@
-}

-- pageView :: (Hyperbole :> es, Handlers views es) => View (Root views) () -> Eff es (Page views)
-- pageView = pure