Class.hs

module Emanote.Route.SiteRoute.Class (
  decodeVirtualRoute,
  noteFileSiteRoute,
  noteFileSiteRoute',
  noteFeedSiteRoute,
  staticFileSiteRoute,
  lmlSiteRoute,
  indexRoute,
  tagIndexRoute,
  taskIndexRoute,
  siteRouteUrl,
  siteRouteUrlStatic,
  urlStrategySuffix,

  -- * Ema stuff
  emanoteRouteEncoder,
  emanoteGeneratableRoutes,
) where

import Data.IxSet.Typed qualified as Ix
import Data.List.NonEmpty qualified as NE
import Data.Set qualified as Set
import Data.Time.Format (defaultTimeLocale, formatTime)
import Ema (UrlStrategy (..), routeUrlWith)
import Emanote.Model qualified as M
import Emanote.Model.Link.Rel qualified as Rel
import Emanote.Model.Meta qualified as Model
import Emanote.Model.Note qualified as N
import Emanote.Model.StaticFile qualified as SF
import Emanote.Model.Type (Model, ModelEma, ModelT)
import Emanote.Pandoc.Markdown.Syntax.HashTag qualified as HT
import Emanote.Route qualified as R
import Emanote.Route.ModelRoute (LMLRoute, StaticFileRoute)
import Emanote.Route.SiteRoute.Type
import Emanote.View.LiveServerFiles qualified as LiveServerFile
import Optics.Core (Prism', prism')
import Optics.Operators ((^.))
import Relude

emanoteGeneratableRoutes :: ModelEma -> [SiteRoute]
emanoteGeneratableRoutes model =
  let htmlRoutes =
        model
          ^. M.modelNotes
            & Ix.toList
            <&> noteFileSiteRoute'
      feedRoutes =
        model
          ^. M.modelNotes
            & Ix.toList
            & filter N.noteHasFeed
            <&> noteFeedSiteRoute
      staticRoutes =
        let includeFile f =
              not (LiveServerFile.isLiveServerFile f)
                || (f == LiveServerFile.tailwindFullJsPath && not (model ^. M.modelCompileTailwind))
         in model
              ^. M.modelStaticFiles
                & Ix.toList
                & filter (includeFile . R.encodeRoute . SF._staticFileRoute)
                <&> staticFileSiteRoute
      virtualRoutes :: [VirtualRoute] =
        let tags = fst <$> M.modelTags model
            tagPaths =
              Set.fromList
                $ ([] :)
                $ concatMap -- [] Triggers generation of main tag index.
                  ( \(HT.deconstructTag -> tagPath) ->
                      NE.filter (not . null) $ NE.inits tagPath
                  )
                  tags
         in VirtualRoute_Index
              : VirtualRoute_Export ExportFormat_Metadata
              : VirtualRoute_Export ExportFormat_Content
              : VirtualRoute_StorkIndex
              : VirtualRoute_TaskIndex
              : (VirtualRoute_TagIndex <$> toList tagPaths)
   in htmlRoutes
        <> feedRoutes
        <> staticRoutes
        <> fmap SiteRoute_VirtualRoute virtualRoutes

emanoteRouteEncoder :: (HasCallStack) => ModelEma -> Prism' FilePath SiteRoute
emanoteRouteEncoder model =
  prism' enc dec
  where
    enc = \case
      SiteRoute_MissingR s ->
        -- error $ toText $ "emanote: attempt to encode a 404 route: " <> s
        -- Unfortunately, since ema:multisite does isomorphism check of
        -- encoder, we can't just error out here.
        s
      SiteRoute_AmbiguousR fp _ ->
        -- FIXME: See note above.
        error $ "emanote: attempt to encode an ambiguous route: " <> toText fp
      SiteRoute_ResourceRoute r ->
        encodeResourceRoute model r
      SiteRoute_VirtualRoute r ->
        encodeVirtualRoute r

    dec fp =
      fmap SiteRoute_VirtualRoute (decodeVirtualRoute fp)
        <|> decodeGeneratedRoute model fp
        <|> pure (SiteRoute_MissingR fp)

encodeResourceRoute :: (HasCallStack) => ModelEma -> ResourceRoute -> FilePath
encodeResourceRoute model = \case
  ResourceRoute_LML view r ->
    -- HACK: This should never fail ... but *if* it does, consult
    -- https://github.com/srid/emanote/issues/148
    fromMaybe
      -- FIXME: See note above.
      (error $ "emanote: attempt to encode missing note resource: " <> show r)
      ( do
          (_, note) <- M.modelLookupNoteByRoute (view, r) model
          case view of
            R.LMLView_Atom -> R.encodeRoute <$> N.noteXmlRoute note
            R.LMLView_Html -> pure $ R.encodeRoute $ N.noteHtmlRoute note
      )
  ResourceRoute_StaticFile r _fpAbs ->
    R.encodeRoute r

-- | Decode a route that is known to refer to a resource in the model
decodeGeneratedRoute :: ModelEma -> FilePath -> Maybe SiteRoute
decodeGeneratedRoute model fp =
  fmap
    staticFileSiteRoute
    (flip M.modelLookupStaticFileByRoute model =<< R.decodeAnyRoute fp)
    <|> mFeedRoute
    <|> noteHtmlSiteRoute
      (flip M.modelLookupNoteByHtmlRoute model $ R.decodeHtmlRoute fp)
  where
    mFeedRoute :: Maybe SiteRoute
    mFeedRoute = case R.decodeXmlRoute fp of
      Nothing -> Nothing
      Just r -> noteFeedSiteRoute <$> M.modelLookupFeedNoteByHtmlRoute r model
    noteHtmlSiteRoute :: Rel.ResolvedRelTarget N.Note -> Maybe SiteRoute
    noteHtmlSiteRoute = \case
      Rel.RRTMissing ->
        Nothing
      Rel.RRTFound note ->
        Just $ noteFileSiteRoute' note
      Rel.RRTAmbiguous notes ->
        Just $ ambiguousNoteURLsRoute notes
    ambiguousNoteURLsRoute :: NonEmpty N.Note -> SiteRoute
    ambiguousNoteURLsRoute ns =
      SiteRoute_AmbiguousR ("/" <> fp) (N._noteRoute <$> ns)

noteFeedSiteRoute :: N.Note -> SiteRoute
noteFeedSiteRoute = SiteRoute_ResourceRoute . ResourceRoute_LML R.LMLView_Atom . N._noteRoute

noteFileSiteRoute :: (R.LMLView, N.Note) -> SiteRoute
noteFileSiteRoute =
  lmlSiteRoute . fmap N._noteRoute

noteFileSiteRoute' :: N.Note -> SiteRoute
noteFileSiteRoute' =
  noteFileSiteRoute . (R.LMLView_Html,)

lmlSiteRoute :: (R.LMLView, LMLRoute) -> SiteRoute
lmlSiteRoute =
  SiteRoute_ResourceRoute . uncurry lmlResourceRoute

lmlResourceRoute :: R.LMLView -> LMLRoute -> ResourceRoute
lmlResourceRoute = ResourceRoute_LML

staticFileSiteRoute :: SF.StaticFile -> SiteRoute
staticFileSiteRoute =
  (SiteRoute_ResourceRoute . staticResourceRoute) . (SF._staticFileRoute &&& SF._staticFilePath)
  where
    staticResourceRoute :: (StaticFileRoute, FilePath) -> ResourceRoute
    staticResourceRoute = uncurry ResourceRoute_StaticFile

{- | Generate the static URL for a site route, including special handling for html-proofer compatibility.

This function builds static URLs by:
1. Getting the base URL using the configured URL strategy (pretty vs direct)
2. For home routes that would result in empty URLs, using the template's baseUrl instead
   to avoid empty href attributes that cause issues with HTML validation tools like html-proofer
3. Handling all route types: resource routes (notes, static files), virtual routes, missing/ambiguous routes
-}
siteRouteUrlStatic :: (HasCallStack) => Model -> SiteRoute -> Text
siteRouteUrlStatic model sr =
  -- For the home route, if the base URL is empty,
  -- use baseUrl from template to avoid empty href attributes which can
  -- cause issues with HTML validation tools like html-proofer
  if url == ""
    then getBaseUrl model
    else url
  where
    (rp, _) = M.withoutRoutePrism model

    url = Ema.routeUrlWith (urlStrategy model) rp sr

    getBaseUrl :: Model -> Text
    getBaseUrl m =
      Model.lookupRouteMeta "/" ("template" :| ["baseUrl"]) (M.modelIndexRoute m) m

-- | Like siteRouteUrlStatic but live-server friendly
siteRouteUrl :: (HasCallStack) => Model -> SiteRoute -> Text
siteRouteUrl model sr =
  siteRouteUrlStatic model sr <> siteRouteQuery
  where
    siteRouteQuery =
      maybe "" (("?t=" <>) . toText . formatTime defaultTimeLocale "%s") staticFileModifiedTime
    staticFileModifiedTime = do
      -- In live server model, we append a ?t=.. to trigger the browser into
      -- reloading (or invalidating its cache of) this embed static file.
      guard $ M.inLiveServer model
      sfRoute <- staticFileRouteCase sr
      sf <- M.modelLookupStaticFileByRoute sfRoute model
      pure $ sf ^. SF.staticFileTime
    staticFileRouteCase :: SiteRoute -> Maybe StaticFileRoute
    staticFileRouteCase = \case
      SiteRoute_MissingR _fp ->
        Nothing
      SiteRoute_AmbiguousR _ _ ->
        Nothing
      SiteRoute_ResourceRoute rr ->
        case rr of
          ResourceRoute_StaticFile sfR _fp ->
            Just sfR
          ResourceRoute_LML _ _ ->
            Nothing
      SiteRoute_VirtualRoute _ -> Nothing

urlStrategySuffix :: Model -> Text
urlStrategySuffix model =
  case urlStrategy model of
    Ema.UrlDirect -> ".html"
    Ema.UrlPretty -> ""

urlStrategy :: ModelT f -> UrlStrategy
urlStrategy model =
  Model.lookupRouteMeta Ema.UrlDirect ("template" :| one "urlStrategy") (M.modelIndexRoute model) model

indexRoute :: SiteRoute
indexRoute =
  SiteRoute_VirtualRoute VirtualRoute_Index

tagIndexRoute :: [HT.TagNode] -> SiteRoute
tagIndexRoute =
  SiteRoute_VirtualRoute . VirtualRoute_TagIndex

taskIndexRoute :: SiteRoute
taskIndexRoute =
  SiteRoute_VirtualRoute VirtualRoute_TaskIndex