diff options
Diffstat (limited to 'source/Render/Html/Context.hs')
| -rw-r--r-- | source/Render/Html/Context.hs | 64 |
1 files changed, 44 insertions, 20 deletions
diff --git a/source/Render/Html/Context.hs b/source/Render/Html/Context.hs index b8894f5..151edd5 100644 --- a/source/Render/Html/Context.hs +++ b/source/Render/Html/Context.hs @@ -4,9 +4,12 @@ -- | Browser-facing routing authority for one rendered HTML page. module Render.Html.Context - ( HtmlRenderContext + ( HtmlRenderEnvironment + , htmlRenderEnvironment + , HtmlRenderContext , HtmlRenderContextError(..) , htmlRenderContext + , htmlRenderContextFromEnvironment , htmlCurrentSource , htmlCurrentPageUrl , htmlCurrentPageLabel @@ -37,36 +40,56 @@ instance Exception HtmlRenderContextError data HtmlRenderContext = HtmlRenderContext { contextCurrentSource :: !ResolvedSource , contextCurrentPageUrl :: !UrlPath - , contextSourceUrls :: !(Map ResolvedSource UrlPath) - , contextRouteNamespaces :: !(Map SourceMountId UrlPath) - , contextSupportScriptUrl :: !UrlPath + , contextEnvironment :: !HtmlRenderEnvironment } deriving stock (Show, Eq) -htmlRenderContext - :: HtmlLayout - -> ResolvedSource - -> Either HtmlRenderContextError HtmlRenderContext -htmlRenderContext layout currentSource = do - let sourceUrls = +data HtmlRenderEnvironment = HtmlRenderEnvironment + { environmentSourceUrls :: !(Map ResolvedSource UrlPath) + , environmentRouteNamespaces :: !(Map SourceMountId UrlPath) + , environmentSupportScriptUrl :: !UrlPath + } + deriving stock (Show, Eq) + +htmlRenderEnvironment :: HtmlLayout -> HtmlRenderEnvironment +htmlRenderEnvironment layout = + HtmlRenderEnvironment + { environmentSourceUrls = Map.fromList [ (source, routeUrlPath route) | (source, route) <- htmlPageRoutes layout ] + , environmentRouteNamespaces = + htmlMountUrlPrefixes layout + , environmentSupportScriptUrl = + routeUrlPath (htmlSupportScriptRoute layout) + } + +htmlRenderContext + :: HtmlLayout + -> ResolvedSource + -> Either HtmlRenderContextError HtmlRenderContext +htmlRenderContext layout = + htmlRenderContextFromEnvironment + (htmlRenderEnvironment layout) + +htmlRenderContextFromEnvironment + :: HtmlRenderEnvironment + -> ResolvedSource + -> Either HtmlRenderContextError HtmlRenderContext +htmlRenderContextFromEnvironment environment currentSource = do currentPageUrl <- maybe (Left (HtmlCurrentSourceNotRouted currentSource)) Right - (Map.lookup currentSource sourceUrls) + (Map.lookup + currentSource + (environmentSourceUrls environment)) Right HtmlRenderContext { contextCurrentSource = currentSource , contextCurrentPageUrl = currentPageUrl - , contextSourceUrls = sourceUrls - , contextRouteNamespaces = - htmlMountUrlPrefixes layout - , contextSupportScriptUrl = - routeUrlPath (htmlSupportScriptRoute layout) + , contextEnvironment = environment } htmlCurrentSource :: HtmlRenderContext -> ResolvedSource @@ -85,17 +108,17 @@ htmlRouteNamespaces :: HtmlRenderContext -> Map SourceMountId UrlPath htmlRouteNamespaces = - contextRouteNamespaces + environmentRouteNamespaces . contextEnvironment htmlSourceUrl :: HtmlRenderContext -> ResolvedSource -> Either HtmlRenderContextError UrlPath -htmlSourceUrl HtmlRenderContext{contextSourceUrls} source = +htmlSourceUrl HtmlRenderContext{contextEnvironment} source = maybe (Left (HtmlReferencedSourceNotRouted source)) Right - (Map.lookup source contextSourceUrls) + (Map.lookup source (environmentSourceUrls contextEnvironment)) htmlSourceLabel :: HtmlRenderContext @@ -136,7 +159,8 @@ htmlSupportScriptHref :: HtmlRenderContext -> Text htmlSupportScriptHref context = renderRelativeUrlPath (contextCurrentPageUrl context) - (contextSupportScriptUrl context) + (environmentSupportScriptUrl + (contextEnvironment context)) resolvedSourceLabel :: ResolvedSource -> Text resolvedSourceLabel source = |