{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.Effect.Hyperbole where

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.State.Static.Local
import Web.Hyperbole.Effect.Server


-- | The 'Hyperbole' 'Effect' allows you to access information in the 'Request', manually 'respondEarly', and manipulate the Client 'session' and 'query'.
data Hyperbole :: Effect where
  GetRequest :: Hyperbole m Request
  RespondEarly :: Response -> Hyperbole m a
  ModClient :: (Client -> Client) -> Hyperbole m ()
  GetClient :: Hyperbole m Client


type instance DispatchOf Hyperbole = 'Dynamic


-- | Run the 'Hyperbole' effect to 'Server'
runHyperbole
  :: (Server :> es)
  => Eff (Hyperbole : es) Response
  -> Eff es Response
runHyperbole :: forall (es :: [Effect]).
(Server :> es) =>
Eff (Hyperbole : es) Response -> Eff es Response
runHyperbole = (Eff es (Either Response (Response, HyperState))
 -> Eff es Response)
-> (Eff (Hyperbole : es) Response
    -> Eff es (Either Response (Response, HyperState)))
-> Eff (Hyperbole : es) Response
-> Eff es Response
forall a b.
(a -> b)
-> (Eff (Hyperbole : es) Response -> a)
-> Eff (Hyperbole : es) Response
-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Eff es (Either Response (Response, HyperState)) -> Eff es Response
forall (es :: [Effect]).
(Server :> es) =>
Eff es (Either Response (Response, HyperState)) -> Eff es Response
combine ((Eff (Hyperbole : es) Response
  -> Eff es (Either Response (Response, HyperState)))
 -> Eff (Hyperbole : es) Response -> Eff es Response)
-> (Eff (Hyperbole : es) Response
    -> Eff es (Either Response (Response, HyperState)))
-> Eff (Hyperbole : es) Response
-> Eff es Response
forall a b. (a -> b) -> a -> b
$ (Eff (State HyperState : Error Response : es) Response
 -> Eff es (Either Response (Response, HyperState)))
-> EffectHandler Hyperbole (State HyperState : Error Response : es)
-> Eff (Hyperbole : es) Response
-> Eff es (Either Response (Response, HyperState))
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (State HyperState : Error Response : es) Response
-> Eff es (Either Response (Response, HyperState))
forall (es :: [Effect]) a.
(Server :> es) =>
Eff (State HyperState : Error Response : es) a
-> Eff es (Either Response (a, HyperState))
runLocal (EffectHandler Hyperbole (State HyperState : Error Response : es)
 -> Eff (Hyperbole : es) Response
 -> Eff es (Either Response (Response, HyperState)))
-> EffectHandler Hyperbole (State HyperState : Error Response : es)
-> Eff (Hyperbole : es) Response
-> Eff es (Either Response (Response, HyperState))
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (State HyperState : Error Response : es)
_ -> \case
  Hyperbole (Eff localEs) a
GetRequest -> do
    forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets @HyperState (.request)
  RespondEarly Response
r -> do
    Client
s <- forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets @HyperState (.client)
    Server (Eff (State HyperState : Error Response : es)) ()
-> Eff (State HyperState : Error Response : es) ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Server (Eff (State HyperState : Error Response : es)) ()
 -> Eff (State HyperState : Error Response : es) ())
-> Server (Eff (State HyperState : Error Response : es)) ()
-> Eff (State HyperState : Error Response : es) ()
forall a b. (a -> b) -> a -> b
$ Client
-> Response
-> Server (Eff (State HyperState : Error Response : es)) ()
forall (a :: * -> *). Client -> Response -> Server a ()
SendResponse Client
s Response
r
    Response -> Eff (State HyperState : Error Response : es) a
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError_ Response
r
  Hyperbole (Eff localEs) a
GetClient -> do
    forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets @HyperState (.client)
  ModClient Client -> Client
f -> do
    forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
(s -> s) -> Eff es ()
modify @HyperState ((HyperState -> HyperState)
 -> Eff (State HyperState : Error Response : es) ())
-> (HyperState -> HyperState)
-> Eff (State HyperState : Error Response : es) ()
forall a b. (a -> b) -> a -> b
$ \HyperState
st -> HyperState
st{client = f st.client}
 where
  runLocal :: (Server :> es) => Eff (State HyperState : Error Response : es) a -> Eff es (Either Response (a, HyperState))
  runLocal :: forall (es :: [Effect]) a.
(Server :> es) =>
Eff (State HyperState : Error Response : es) a
-> Eff es (Either Response (a, HyperState))
runLocal Eff (State HyperState : Error Response : es) a
eff = do
    -- Load the request ONCE right when we start
    Request
r <- Server (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 Server (Eff es) Request
forall (a :: * -> *). Server a Request
LoadRequest
    let client :: Client
client = Cookies -> Maybe QueryData -> Client
Client Cookies
forall a. Monoid a => a
mempty Maybe QueryData
forall a. Monoid a => a
mempty
    let st :: HyperState
st = Request -> Client -> HyperState
HyperState Request
r Client
client
    forall e (es :: [Effect]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @Response (Eff (Error Response : es) (a, HyperState)
 -> Eff es (Either Response (a, HyperState)))
-> (Eff (State HyperState : Error Response : es) a
    -> Eff (Error Response : es) (a, HyperState))
-> Eff (State HyperState : Error Response : es) a
-> Eff es (Either Response (a, HyperState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HyperState
-> Eff (State HyperState : Error Response : es) a
-> Eff (Error Response : es) (a, HyperState)
forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState HyperState
st (Eff (State HyperState : Error Response : es) a
 -> Eff es (Either Response (a, HyperState)))
-> Eff (State HyperState : Error Response : es) a
-> Eff es (Either Response (a, HyperState))
forall a b. (a -> b) -> a -> b
$ Eff (State HyperState : Error Response : es) a
eff

  combine :: (Server :> es) => Eff es (Either Response (Response, HyperState)) -> Eff es Response
  combine :: forall (es :: [Effect]).
(Server :> es) =>
Eff es (Either Response (Response, HyperState)) -> Eff es Response
combine Eff es (Either Response (Response, HyperState))
eff = do
    Either Response (Response, HyperState)
er <- Eff es (Either Response (Response, HyperState))
eff
    case Either Response (Response, HyperState)
er of
      Left Response
res ->
        -- responded early, don't need to respond again
        Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res
      Right (Response
res, HyperState
st) -> do
        Server (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Server (Eff es) () -> Eff es ())
-> Server (Eff es) () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Client -> Response -> Server (Eff es) ()
forall (a :: * -> *). Client -> Response -> Server a ()
SendResponse HyperState
st.client Response
res
        Response -> Eff es Response
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
res


data HyperState = HyperState
  { HyperState -> Request
request :: Request
  , HyperState -> Client
client :: Client
  }