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.tailwindFullCssPath && 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 $
                ([] :) $ -- [] Triggers generation of main tag index.
                  concat $
                    tags <&> \(HT.deconstructTag -> tagPath) ->
                      NE.filter (not . null) $ NE.inits tagPath
         in VirtualRoute_Index
              : VirtualRoute_Export
              : 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

-- | Like `siteRouteUrl` but avoids any dynamism in the URL
siteRouteUrlStatic :: (HasCallStack) => Model -> SiteRoute -> Text
siteRouteUrlStatic model =
  Ema.routeUrlWith (urlStrategy model) rp
  where
    (rp, _) = M.withoutRoutePrism model

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