{-# LANGUAGE AllowAmbiguousTypes #-}
{-|
Module: IHP.ActionType
Copyright: (c) digitally induced GmbH, 2025

Provides ActionType for tracking the current controller action type
in the WAI request vault.
-}
module IHP.ActionType
( ActionType(..)
, actionTypeVaultKey
, requestActionType
, setActionType
, isActiveController
) where

import Prelude
import GHC.Records (HasField(..))
import Data.Typeable (Typeable)
import Network.Wai
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Vault.Lazy as Vault
import qualified Data.Typeable as Typeable
import Data.Proxy

-- | Used to track the current action type
newtype ActionType = ActionType Typeable.TypeRep

actionTypeVaultKey :: Vault.Key ActionType
actionTypeVaultKey :: Key ActionType
actionTypeVaultKey = IO (Key ActionType) -> Key ActionType
forall a. IO a -> a
unsafePerformIO IO (Key ActionType)
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE actionTypeVaultKey #-}

requestActionType :: Request -> ActionType
requestActionType :: Request -> ActionType
requestActionType Request
req =
    case Key ActionType -> Vault -> Maybe ActionType
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key ActionType
actionTypeVaultKey Request
req.vault of
        Just ActionType
actionType -> ActionType
actionType
        Maybe ActionType
Nothing -> [Char] -> ActionType
forall a. HasCallStack => [Char] -> a
error [Char]
"requestActionType: ActionType not found in request vault"

-- | Insert the ActionType into the request vault
{-# INLINE setActionType #-}
setActionType :: Typeable controller => controller -> Request -> Request
setActionType :: forall controller.
Typeable controller =>
controller -> Request -> Request
setActionType controller
controller Request
req = Request
req { vault = Vault.insert actionTypeVaultKey (ActionType (Typeable.typeOf controller)) req.vault }

instance HasField "actionType" Request ActionType where
    getField :: Request -> ActionType
getField = Request -> ActionType
requestActionType

-- | Returns @True@ when the given type matches the type of the currently executed controller action
--
-- __Example:__ The browser has requested @\/Posts@ and the @Posts@ action of the @PostsController@ is called.
--
-- >>> isActiveController @PostsController
-- True
--
-- Returns @True@ because the current action is part of the @PostsController@
isActiveController :: forall controller. (?request :: Request, Typeable controller) => Bool
isActiveController :: forall {k} (controller :: k).
(?request::Request, Typeable controller) =>
Bool
isActiveController =
    let
        (ActionType TypeRep
actionType) = ?request::Request
Request
?request.actionType
    in
        (Proxy controller -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @controller)) TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
actionType