{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.Effect.Hyperbole where

import Data.Aeson (Value)
import Data.Text (Text)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.State.Static.Local
import Effectful.Writer.Static.Local
import Web.Hyperbole.Data.Encoded
import Web.Hyperbole.Types.Client
import Web.Hyperbole.Types.Event
import Web.Hyperbole.Types.Request
import Web.Hyperbole.Types.Response


-- | The 'Hyperbole' 'Effect' allows you to access information in the 'Request', manually respond, and manipulate the Client 'session' and 'query'.
data Hyperbole :: Effect where
  GetRequest :: Hyperbole m Request
  RespondNow :: Response -> Hyperbole m a
  PushUpdate :: ViewUpdate -> Hyperbole m ()
  ModClient :: (Client -> Client) -> Hyperbole m ()
  GetClient :: Hyperbole m Client
  PushTrigger :: TargetViewId -> Encoded -> Hyperbole m ()
  PushEvent :: Text -> Value -> Hyperbole m ()


type instance DispatchOf Hyperbole = 'Dynamic


data Remote
  = RemoteAction TargetViewId Encoded
  | RemoteEvent Text Value


runHyperboleLocal :: Request -> Eff (Error Response : State Client : Writer [Remote] : es) Response -> Eff es (Response, Client, [Remote])
runHyperboleLocal :: forall (es :: [(* -> *) -> * -> *]).
Request
-> Eff
     (Error Response : State Client : Writer [Remote] : es) Response
-> Eff es (Response, Client, [Remote])
runHyperboleLocal Request
req Eff (Error Response : State Client : Writer [Remote] : es) Response
eff = do
  ((eresp, client'), rmts) <- forall w (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
runWriter @[Remote] (Eff (Writer [Remote] : es) (Either Response Response, Client)
 -> Eff es ((Either Response Response, Client), [Remote]))
-> (Eff
      (Error Response : State Client : Writer [Remote] : es) Response
    -> Eff (Writer [Remote] : es) (Either Response Response, Client))
-> Eff
     (Error Response : State Client : Writer [Remote] : es) Response
-> Eff es ((Either Response Response, Client), [Remote])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client
-> Eff
     (State Client : Writer [Remote] : es) (Either Response Response)
-> Eff (Writer [Remote] : es) (Either Response Response, Client)
forall s (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState (RequestId -> Client
emptyClient Request
req.requestId) (Eff
   (State Client : Writer [Remote] : es) (Either Response Response)
 -> Eff (Writer [Remote] : es) (Either Response Response, Client))
-> (Eff
      (Error Response : State Client : Writer [Remote] : es) Response
    -> Eff
         (State Client : Writer [Remote] : es) (Either Response Response))
-> Eff
     (Error Response : State Client : Writer [Remote] : es) Response
-> Eff (Writer [Remote] : es) (Either Response Response, Client)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @Response (Eff
   (Error Response : State Client : Writer [Remote] : es) Response
 -> Eff es ((Either Response Response, Client), [Remote]))
-> Eff
     (Error Response : State Client : Writer [Remote] : es) Response
-> Eff es ((Either Response Response, Client), [Remote])
forall a b. (a -> b) -> a -> b
$ Eff (Error Response : State Client : Writer [Remote] : es) Response
eff
  pure (either id id eresp, client', rmts)
 where
  emptyClient :: RequestId -> Client
  emptyClient :: RequestId -> Client
emptyClient RequestId
requestId =
    Client
      { RequestId
requestId :: RequestId
requestId :: RequestId
requestId
      , session :: Cookies
session = Cookies
forall a. Monoid a => a
mempty
      , query :: Maybe QueryData
query = Maybe QueryData
forall a. Monoid a => a
mempty
      , pageTitle :: Maybe Text
pageTitle = Maybe Text
forall a. Maybe a
Nothing
      }


-- | Return all information about the 'Request'
request :: (Hyperbole :> es) => Eff es Request
request :: forall (es :: [(* -> *) -> * -> *]).
(Hyperbole :> es) =>
Eff es Request
request = Hyperbole (Eff es) Request -> Eff es Request
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Hyperbole (Eff es) Request
forall (m :: * -> *). Hyperbole m Request
GetRequest