module IHP.Controller.Context where
import IHP.Prelude
import qualified Data.TMap as TypeMap
import qualified Data.Typeable as Typeable
import IHP.Controller.RequestContext
import IHP.FrameworkConfig
import IHP.Log.Types
data ControllerContext = ControllerContext { ControllerContext -> RequestContext
requestContext :: RequestContext, ControllerContext -> IORef TMap
customFieldsRef :: IORef TypeMap.TMap }
| FrozenControllerContext { requestContext :: RequestContext, ControllerContext -> TMap
customFields :: TypeMap.TMap }
newControllerContext :: (?requestContext :: RequestContext) => IO ControllerContext
newControllerContext :: (?requestContext::RequestContext) => IO ControllerContext
newControllerContext = do
IORef TMap
customFieldsRef <- forall a. a -> IO (IORef a)
newIORef TMap
TypeMap.empty
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControllerContext { $sel:requestContext:ControllerContext :: RequestContext
requestContext = ?requestContext::RequestContext
?requestContext, IORef TMap
customFieldsRef :: IORef TMap
$sel:customFieldsRef:ControllerContext :: IORef TMap
customFieldsRef }
{-# INLINABLE newControllerContext #-}
freeze :: ControllerContext -> IO ControllerContext
freeze :: ControllerContext -> IO ControllerContext
freeze ControllerContext { RequestContext
requestContext :: RequestContext
$sel:requestContext:ControllerContext :: ControllerContext -> RequestContext
requestContext, IORef TMap
customFieldsRef :: IORef TMap
$sel:customFieldsRef:ControllerContext :: ControllerContext -> IORef TMap
customFieldsRef } = RequestContext -> TMap -> ControllerContext
FrozenControllerContext RequestContext
requestContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef TMap
customFieldsRef
freeze ControllerContext
frozen = forall (f :: * -> *) a. Applicative f => a -> f a
pure ControllerContext
frozen
{-# INLINABLE freeze #-}
unfreeze :: ControllerContext -> IO ControllerContext
unfreeze :: ControllerContext -> IO ControllerContext
unfreeze FrozenControllerContext { RequestContext
requestContext :: RequestContext
$sel:requestContext:ControllerContext :: ControllerContext -> RequestContext
requestContext, TMap
customFields :: TMap
$sel:customFields:ControllerContext :: ControllerContext -> TMap
customFields } = do
IORef TMap
customFieldsRef <- forall a. a -> IO (IORef a)
newIORef TMap
customFields
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControllerContext { IORef TMap
RequestContext
customFieldsRef :: IORef TMap
requestContext :: RequestContext
$sel:customFieldsRef:ControllerContext :: IORef TMap
$sel:requestContext:ControllerContext :: RequestContext
.. }
unfreeze ControllerContext {} = forall a. Text -> a
error Text
"Cannot call unfreeze on a controller context that is not frozen"
{-# INLINABLE unfreeze #-}
fromContext :: forall value. (?context :: ControllerContext, Typeable value) => IO value
fromContext :: forall value.
(?context::ControllerContext, Typeable value) =>
IO value
fromContext = forall value.
(?context::ControllerContext, Typeable value) =>
IO (Maybe value)
maybeFromContext @value forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just value
value -> forall (f :: * -> *) a. Applicative f => a -> f a
pure value
value
Maybe value
Nothing -> do
let ControllerContext { IORef TMap
customFieldsRef :: IORef TMap
$sel:customFieldsRef:ControllerContext :: ControllerContext -> IORef TMap
customFieldsRef } = ?context::ControllerContext
?context
TMap
customFields <- forall a. IORef a -> IO a
readIORef IORef TMap
customFieldsRef
let notFoundMessage :: Text
notFoundMessage = (Text
"Unable to find " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> Text
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (forall {k} (t :: k). Proxy t
Typeable.Proxy @value))) forall a. Semigroup a => a -> a -> a
<> Text
" in controller context: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
show TMap
customFields)
forall a. Text -> a
error Text
notFoundMessage
{-# INLINABLE fromContext #-}
fromFrozenContext :: forall value. (?context :: ControllerContext, Typeable value) => value
fromFrozenContext :: forall value.
(?context::ControllerContext, Typeable value) =>
value
fromFrozenContext = case forall value.
(?context::ControllerContext, Typeable value) =>
Maybe value
maybeFromFrozenContext @value of
Just value
value -> value
value
Maybe value
Nothing -> do
let FrozenControllerContext { TMap
customFields :: TMap
$sel:customFields:ControllerContext :: ControllerContext -> TMap
customFields } = ?context::ControllerContext
?context
let notFoundMessage :: Text
notFoundMessage = (Text
"Unable to find " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> Text
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (forall {k} (t :: k). Proxy t
Typeable.Proxy @value))) forall a. Semigroup a => a -> a -> a
<> Text
" in controller context: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
show TMap
customFields)
forall a. Text -> a
error Text
notFoundMessage
{-# INLINABLE fromFrozenContext #-}
maybeFromContext :: forall value. (?context :: ControllerContext, Typeable value) => IO (Maybe value)
maybeFromContext :: forall value.
(?context::ControllerContext, Typeable value) =>
IO (Maybe value)
maybeFromContext = do
ControllerContext
frozen <- ControllerContext -> IO ControllerContext
freeze ?context::ControllerContext
?context
let ?context = ControllerContext
frozen
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall value.
(?context::ControllerContext, Typeable value) =>
Maybe value
maybeFromFrozenContext @value)
{-# INLINABLE maybeFromContext #-}
maybeFromFrozenContext :: forall value. (?context :: ControllerContext, Typeable value) => Maybe value
maybeFromFrozenContext :: forall value.
(?context::ControllerContext, Typeable value) =>
Maybe value
maybeFromFrozenContext = case ?context::ControllerContext
?context of
FrozenControllerContext { TMap
customFields :: TMap
$sel:customFields:ControllerContext :: ControllerContext -> TMap
customFields } -> forall a. Typeable a => TMap -> Maybe a
TypeMap.lookup @value TMap
customFields
ControllerContext {} -> forall a. Text -> a
error (Text
"maybeFromFrozenContext called on a non frozen context while trying to access " forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> Text
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (forall {k} (t :: k). Proxy t
Typeable.Proxy @value))))
{-# INLINABLE maybeFromFrozenContext #-}
putContext :: forall value. (?context :: ControllerContext, Typeable value) => value -> IO ()
putContext :: forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext value
value = do
let ControllerContext { IORef TMap
customFieldsRef :: IORef TMap
$sel:customFieldsRef:ControllerContext :: ControllerContext -> IORef TMap
customFieldsRef } = ?context::ControllerContext
?context
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef TMap
customFieldsRef (forall a. Typeable a => a -> TMap -> TMap
TypeMap.insert value
value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINABLE putContext #-}
newtype ActionType = ActionType Typeable.TypeRep
instance HasField "frameworkConfig" ControllerContext FrameworkConfig where
getField :: ControllerContext -> FrameworkConfig
getField ControllerContext
controllerContext = ControllerContext
controllerContext.requestContext.frameworkConfig
{-# INLINABLE getField #-}
instance HasField "logger" ControllerContext Logger where
getField :: ControllerContext -> Logger
getField ControllerContext
controllerContext = ControllerContext
controllerContext.frameworkConfig.logger