diff --git a/IHP/Controller/Context.hs b/IHP/Controller/Context.hs index 61a8cd3bc..7c5b81925 100644 --- a/IHP/Controller/Context.hs +++ b/IHP/Controller/Context.hs @@ -47,20 +47,22 @@ import IHP.Log.Types -- - @action ..@: The action itself. -- - Freezing: Before rendering the response, the container is frozen. Frozen means that all previously mutable fields become immutable. -- - View Rendering: The frozen container is now used inside the view and layout to display information such as the current user or flash messages -data ControllerContext = ControllerContext { requestContext :: RequestContext, customFieldsRef :: IORef TypeMap.TMap } - | FrozenControllerContext { requestContext :: RequestContext, customFields :: TypeMap.TMap } +data ControllerContext = ControllerContext { requestContext :: RequestContext, customFieldsRef :: IORef TypeMap.TMap, logger :: Logger } + | FrozenControllerContext { requestContext :: RequestContext, customFields :: TypeMap.TMap, logger :: Logger } newControllerContext :: (?requestContext :: RequestContext) => IO ControllerContext newControllerContext = do customFieldsRef <- newIORef TypeMap.empty - pure ControllerContext { requestContext = ?requestContext, customFieldsRef } + pure ControllerContext { requestContext = ?requestContext, customFieldsRef, logger = ?requestContext.frameworkConfig.logger } {-# INLINABLE newControllerContext #-} -- | After freezing a container you can access its values from pure non-IO code by using 'fromFronzenContext' -- -- Calls to 'putContext' will throw an exception after it's frozen. freeze :: ControllerContext -> IO ControllerContext -freeze ControllerContext { requestContext, customFieldsRef } = FrozenControllerContext requestContext <$> readIORef customFieldsRef +freeze ControllerContext { requestContext, customFieldsRef, logger } = do + customFields <- readIORef customFieldsRef + pure FrozenControllerContext { requestContext, customFields, logger } freeze frozen = pure frozen {-# INLINABLE freeze #-} @@ -68,7 +70,7 @@ freeze frozen = pure frozen -- -- This is used together with 'freeze' by e.g. AutoRefresh to make a immutable copy of the current controller context state unfreeze :: ControllerContext -> IO ControllerContext -unfreeze FrozenControllerContext { requestContext, customFields } = do +unfreeze FrozenControllerContext { requestContext, customFields, logger } = do customFieldsRef <- newIORef customFields pure ControllerContext { .. } unfreeze ControllerContext {} = error "Cannot call unfreeze on a controller context that is not frozen" @@ -135,7 +137,4 @@ newtype ActionType = ActionType Typeable.TypeRep instance HasField "frameworkConfig" ControllerContext FrameworkConfig where getField controllerContext = controllerContext.requestContext.frameworkConfig - {-# INLINABLE getField #-} - -instance HasField "logger" ControllerContext Logger where - getField controllerContext = controllerContext.frameworkConfig.logger + {-# INLINABLE getField #-} \ No newline at end of file diff --git a/IHP/ControllerSupport.hs b/IHP/ControllerSupport.hs index a5468b0ef..df93bcc73 100644 --- a/IHP/ControllerSupport.hs +++ b/IHP/ControllerSupport.hs @@ -66,6 +66,10 @@ class InitControllerContext application where initContext = pure () {-# INLINABLE initContext #-} + mapContext :: (?modelContext :: ModelContext, ?requestContext :: RequestContext, ?applicationContext :: ApplicationContext, ?context :: ControllerContext) => ControllerContext -> ControllerContext + mapContext context = context + {-# INLINABLE mapContext #-} + {-# INLINE runAction #-} runAction :: forall controller. (Controller controller, ?context :: ControllerContext, ?modelContext :: ModelContext, ?applicationContext :: ApplicationContext, ?requestContext :: RequestContext) => controller -> IO ResponseReceived runAction controller = do @@ -123,7 +127,7 @@ newContextForAction contextSetter controller = do let respond = ?context.requestContext.respond in respond response Nothing -> ErrorController.displayException exception controller " while calling initContext" - Right _ -> pure $ Right ?context + Right _ -> pure $ Right (mapContext @application ?context) {-# INLINE runActionWithNewContext #-} runActionWithNewContext :: forall application controller. (Controller controller, ?applicationContext :: ApplicationContext, ?context :: RequestContext, InitControllerContext application, ?application :: application, Typeable application, Typeable controller) => controller -> IO ResponseReceived diff --git a/IHP/RouterSupport.hs b/IHP/RouterSupport.hs index 2e88ea0be..d7634ada9 100644 --- a/IHP/RouterSupport.hs +++ b/IHP/RouterSupport.hs @@ -955,7 +955,7 @@ routeParam :: (?context::RequestContext, ParamReader paramType) => ByteString -> routeParam paramName = let requestContext = ?context in - let ?context = FrozenControllerContext { requestContext = requestContext, customFields = mempty } + let ?context = FrozenControllerContext { requestContext = requestContext, customFields = mempty, logger = requestContext.frameworkConfig.logger } in param paramName -- | Display a better error when the user missed to pass an argument to an action.