{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Browser-facing routing authority for one rendered HTML page.
module Felix.Render.Html.Context
    ( HtmlRenderEnvironment
    , htmlRenderEnvironment
    , HtmlRenderContext
    , HtmlRenderContextError(..)
    , htmlRenderContext
    , htmlRenderContextFromEnvironment
    , htmlCurrentSource
    , htmlCurrentPageUrl
    , htmlCurrentPageLabel
    , htmlRouteNamespaces
    , htmlSourceUrl
    , htmlSourceLabel
    , htmlSourcePageHref
    , htmlSourceFragmentHref
    , htmlSupportScriptHref
    ) where

import Base
import Felix.Source
import Felix.Render.Html.Layout

import Control.Exception (Exception)
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text


data HtmlRenderContextError
    = HtmlCurrentSourceNotRouted !ResolvedSource
    | HtmlReferencedSourceNotRouted !ResolvedSource
    deriving stock (Show, Eq)

instance Exception HtmlRenderContextError

data HtmlRenderContext = HtmlRenderContext
    { contextCurrentSource :: !ResolvedSource
    , contextCurrentPageUrl :: !UrlPath
    , contextEnvironment :: !HtmlRenderEnvironment
    }
    deriving stock (Show, Eq)

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
                (environmentSourceUrls environment))
    Right
        HtmlRenderContext
            { contextCurrentSource = currentSource
            , contextCurrentPageUrl = currentPageUrl
            , contextEnvironment = environment
            }

htmlCurrentSource :: HtmlRenderContext -> ResolvedSource
htmlCurrentSource =
    contextCurrentSource

htmlCurrentPageUrl :: HtmlRenderContext -> UrlPath
htmlCurrentPageUrl =
    contextCurrentPageUrl

htmlCurrentPageLabel :: HtmlRenderContext -> Text
htmlCurrentPageLabel context =
    resolvedSourceLabel (contextCurrentSource context)

htmlRouteNamespaces
    :: HtmlRenderContext
    -> Map SourceMountId UrlPath
htmlRouteNamespaces =
    environmentRouteNamespaces . contextEnvironment

htmlSourceUrl
    :: HtmlRenderContext
    -> ResolvedSource
    -> Either HtmlRenderContextError UrlPath
htmlSourceUrl HtmlRenderContext{contextEnvironment} source =
    maybe
        (Left (HtmlReferencedSourceNotRouted source))
        Right
        (Map.lookup source (environmentSourceUrls contextEnvironment))

htmlSourceLabel
    :: HtmlRenderContext
    -> ResolvedSource
    -> Either HtmlRenderContextError Text
htmlSourceLabel context source = do
    _url <- htmlSourceUrl context source
    Right (resolvedSourceLabel source)

htmlSourcePageHref
    :: HtmlRenderContext
    -> ResolvedSource
    -> Either HtmlRenderContextError Text
htmlSourcePageHref context source =
    renderRelativeUrlPath
        (contextCurrentPageUrl context)
        <$> htmlSourceUrl context source

htmlSourceFragmentHref
    :: HtmlRenderContext
    -> ResolvedSource
    -> Text
    -> Either HtmlRenderContextError Text
htmlSourceFragmentHref context source fragment = do
    target <- htmlSourceUrl context source
    let encodedFragment =
            renderUrlFragment fragment
    Right
        (if target == contextCurrentPageUrl context
            then encodedFragment
            else
                renderRelativeUrlPath
                    (contextCurrentPageUrl context)
                    target
                    <> encodedFragment)

htmlSupportScriptHref :: HtmlRenderContext -> Text
htmlSupportScriptHref context =
    renderRelativeUrlPath
        (contextCurrentPageUrl context)
        (environmentSupportScriptUrl
            (contextEnvironment context))

resolvedSourceLabel :: ResolvedSource -> Text
resolvedSourceLabel source =
    sourceMountIdText (resolvedSourceMount source)
        <> ":"
        <> Text.pack
            (safeRelativePathFilePath
                (resolvedSourceRelativePath source))