module Emanote.Route.SiteRoute.Class (
  decodeVirtualRoute,
  noteFileSiteRoute,
  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 :: ModelEma -> [SiteRoute]
emanoteGeneratableRoutes ModelEma
model =
  let htmlRoutes :: [SiteRoute]
htmlRoutes =
        ModelEma
model forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
M.modelNotes
          forall a b. a -> (a -> b) -> b
& forall (ixs :: IxList) a. IxSet ixs a -> [a]
Ix.toList
          forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> Note -> SiteRoute
noteFileSiteRoute
      staticRoutes :: [SiteRoute]
staticRoutes =
        let includeFile :: FilePath -> Bool
includeFile FilePath
f =
              Bool -> Bool
not (FilePath -> Bool
LiveServerFile.isLiveServerFile FilePath
f)
                Bool -> Bool -> Bool
|| (FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
LiveServerFile.tailwindFullCssPath Bool -> Bool -> Bool
&& Bool -> Bool
not (ModelEma
model forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) Bool
M.modelCompileTailwind))
         in ModelEma
model forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
M.modelStaticFiles
              forall a b. a -> (a -> b) -> b
& forall (ixs :: IxList) a. IxSet ixs a -> [a]
Ix.toList
              forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> Bool
includeFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticFile -> R @SourceExt 'AnyExt
SF._staticFileRoute)
              forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> StaticFile -> SiteRoute
staticFileSiteRoute
      [VirtualRoute]
virtualRoutes :: [VirtualRoute] =
        let tags :: [Tag]
tags = forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type). ModelT f -> [(Tag, [Note])]
M.modelTags ModelEma
model
            tagPaths :: Set [TagNode]
tagPaths =
              forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
                ([] :) forall a b. (a -> b) -> a -> b
$ -- [] Triggers generation of main tag index.
                  forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                    [Tag]
tags forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \(HasCallStack => Tag -> NonEmpty TagNode
HT.deconstructTag -> NonEmpty TagNode
tagPath) ->
                      forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Foldable f => f a -> NonEmpty [a]
NE.inits NonEmpty TagNode
tagPath
         in VirtualRoute
VirtualRoute_Index
              forall a. a -> [a] -> [a]
: VirtualRoute
VirtualRoute_Export
              forall a. a -> [a] -> [a]
: VirtualRoute
VirtualRoute_StorkIndex
              forall a. a -> [a] -> [a]
: VirtualRoute
VirtualRoute_TaskIndex
              forall a. a -> [a] -> [a]
: ([TagNode] -> VirtualRoute
VirtualRoute_TagIndex forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Set [TagNode]
tagPaths)
   in [SiteRoute]
htmlRoutes
        forall a. Semigroup a => a -> a -> a
<> [SiteRoute]
staticRoutes
        forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap VirtualRoute -> SiteRoute
SiteRoute_VirtualRoute [VirtualRoute]
virtualRoutes

emanoteRouteEncoder :: HasCallStack => ModelEma -> Prism' FilePath SiteRoute
emanoteRouteEncoder :: HasCallStack => ModelEma -> Prism' FilePath SiteRoute
emanoteRouteEncoder ModelEma
model =
  forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SiteRoute -> FilePath
enc FilePath -> Maybe SiteRoute
dec
  where
    enc :: SiteRoute -> FilePath
enc = \case
      SiteRoute_MissingR FilePath
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.
        FilePath
s
      SiteRoute_AmbiguousR FilePath
fp NonEmpty LMLRoute
_ ->
        -- FIXME: See note above.
        forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"emanote: attempt to encode an ambiguous route: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
fp
      SiteRoute_ResourceRoute ResourceRoute
r ->
        HasCallStack => ModelEma -> ResourceRoute -> FilePath
encodeResourceRoute ModelEma
model ResourceRoute
r
      SiteRoute_VirtualRoute VirtualRoute
r ->
        VirtualRoute -> FilePath
encodeVirtualRoute VirtualRoute
r

    dec :: FilePath -> Maybe SiteRoute
dec FilePath
fp =
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap VirtualRoute -> SiteRoute
SiteRoute_VirtualRoute (FilePath -> Maybe VirtualRoute
decodeVirtualRoute FilePath
fp)
        forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ModelEma -> FilePath -> Maybe SiteRoute
decodeGeneratedRoute ModelEma
model FilePath
fp
        forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (FilePath -> SiteRoute
SiteRoute_MissingR FilePath
fp)

encodeResourceRoute :: HasCallStack => ModelEma -> ResourceRoute -> FilePath
encodeResourceRoute :: HasCallStack => ModelEma -> ResourceRoute -> FilePath
encodeResourceRoute ModelEma
model = \case
  ResourceRoute_LML LMLRoute
r ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute
      forall a b. (a -> b) -> a -> b
$
      -- HACK: This should never fail ... but *if* it does, consult
      -- https://github.com/srid/emanote/issues/148
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        -- FIXME: See note above.
        (forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"emanote: attempt to encode missing note: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LMLRoute
r)
        Note -> R @() 'Html
N.noteHtmlRoute
      forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
M.modelLookupNoteByRoute LMLRoute
r ModelEma
model
  ResourceRoute_StaticFile R @SourceExt 'AnyExt
r FilePath
_fpAbs ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute R @SourceExt 'AnyExt
r

-- | Decode a route that is known to refer to a resource in the model
decodeGeneratedRoute :: ModelEma -> FilePath -> Maybe SiteRoute
decodeGeneratedRoute :: ModelEma -> FilePath -> Maybe SiteRoute
decodeGeneratedRoute ModelEma
model FilePath
fp =
  forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
    StaticFile -> SiteRoute
staticFileSiteRoute
    (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> Maybe StaticFile
M.modelLookupStaticFileByRoute ModelEma
model forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Maybe (R @SourceExt 'AnyExt)
R.decodeAnyRoute FilePath
fp)
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ResolvedRelTarget Note -> Maybe SiteRoute
noteHtmlSiteRoute
      (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: Type -> Type).
R @() 'Html -> ModelT f -> ResolvedRelTarget Note
M.modelLookupNoteByHtmlRoute ModelEma
model forall a b. (a -> b) -> a -> b
$ FilePath -> R @() 'Html
R.decodeHtmlRoute FilePath
fp)
  where
    noteHtmlSiteRoute :: Rel.ResolvedRelTarget N.Note -> Maybe SiteRoute
    noteHtmlSiteRoute :: ResolvedRelTarget Note -> Maybe SiteRoute
noteHtmlSiteRoute = \case
      ResolvedRelTarget Note
Rel.RRTMissing ->
        forall a. Maybe a
Nothing
      Rel.RRTFound Note
note ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Note -> SiteRoute
noteFileSiteRoute Note
note
      Rel.RRTAmbiguous NonEmpty Note
notes ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NonEmpty Note -> SiteRoute
ambiguousNoteURLsRoute NonEmpty Note
notes
    ambiguousNoteURLsRoute :: NonEmpty N.Note -> SiteRoute
    ambiguousNoteURLsRoute :: NonEmpty Note -> SiteRoute
ambiguousNoteURLsRoute NonEmpty Note
ns =
      FilePath -> NonEmpty LMLRoute -> SiteRoute
SiteRoute_AmbiguousR (FilePath
"/" forall a. Semigroup a => a -> a -> a
<> FilePath
fp) (Note -> LMLRoute
N._noteRoute forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Note
ns)

noteFileSiteRoute :: N.Note -> SiteRoute
noteFileSiteRoute :: Note -> SiteRoute
noteFileSiteRoute =
  LMLRoute -> SiteRoute
lmlSiteRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> LMLRoute
N._noteRoute

lmlSiteRoute :: LMLRoute -> SiteRoute
lmlSiteRoute :: LMLRoute -> SiteRoute
lmlSiteRoute =
  ResourceRoute -> SiteRoute
SiteRoute_ResourceRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> ResourceRoute
lmlResourceRoute

lmlResourceRoute :: LMLRoute -> ResourceRoute
lmlResourceRoute :: LMLRoute -> ResourceRoute
lmlResourceRoute = LMLRoute -> ResourceRoute
ResourceRoute_LML

staticFileSiteRoute :: SF.StaticFile -> SiteRoute
staticFileSiteRoute :: StaticFile -> SiteRoute
staticFileSiteRoute =
  (ResourceRoute -> SiteRoute
SiteRoute_ResourceRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. (R @SourceExt 'AnyExt, FilePath) -> ResourceRoute
staticResourceRoute) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StaticFile -> R @SourceExt 'AnyExt
SF._staticFileRoute forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& StaticFile -> FilePath
SF._staticFilePath)
  where
    staticResourceRoute :: (StaticFileRoute, FilePath) -> ResourceRoute
    staticResourceRoute :: (R @SourceExt 'AnyExt, FilePath) -> ResourceRoute
staticResourceRoute = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry R @SourceExt 'AnyExt -> FilePath -> ResourceRoute
ResourceRoute_StaticFile

-- | Like `siteRouteUrl` but avoids any dynamism in the URL
siteRouteUrlStatic :: HasCallStack => Model -> SiteRoute -> Text
siteRouteUrlStatic :: HasCallStack => Model -> SiteRoute -> Text
siteRouteUrlStatic Model
model =
  forall r.
HasCallStack =>
UrlStrategy -> Prism' FilePath r -> r -> Text
Ema.routeUrlWith (forall (f :: Type -> Type). ModelT f -> UrlStrategy
urlStrategy Model
model) Prism' FilePath SiteRoute
rp
  where
    (Prism' FilePath SiteRoute
rp, ModelEma
_) = Model -> (Prism' FilePath SiteRoute, ModelEma)
M.withoutRoutePrism Model
model

siteRouteUrl :: HasCallStack => Model -> SiteRoute -> Text
siteRouteUrl :: HasCallStack => Model -> SiteRoute -> Text
siteRouteUrl Model
model SiteRoute
sr =
  HasCallStack => Model -> SiteRoute -> Text
siteRouteUrlStatic Model
model SiteRoute
sr
    forall a. Semigroup a => a -> a -> a
<> Text
siteRouteQuery
  where
    siteRouteQuery :: Text
siteRouteQuery =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"?t=" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%s") Maybe UTCTime
staticFileModifiedTime
    staticFileModifiedTime :: Maybe UTCTime
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.
      forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Model -> Bool
M.inLiveServer Model
model
      R @SourceExt 'AnyExt
sfRoute <- SiteRoute -> Maybe (R @SourceExt 'AnyExt)
staticFileRouteCase SiteRoute
sr
      StaticFile
sf <- forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> Maybe StaticFile
M.modelLookupStaticFileByRoute R @SourceExt 'AnyExt
sfRoute Model
model
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StaticFile
sf forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' StaticFile UTCTime
SF.staticFileTime
    staticFileRouteCase :: SiteRoute -> Maybe StaticFileRoute
    staticFileRouteCase :: SiteRoute -> Maybe (R @SourceExt 'AnyExt)
staticFileRouteCase = \case
      SiteRoute_MissingR FilePath
_fp ->
        forall a. Maybe a
Nothing
      SiteRoute_AmbiguousR FilePath
_ NonEmpty LMLRoute
_ ->
        forall a. Maybe a
Nothing
      SiteRoute_ResourceRoute ResourceRoute
rr ->
        case ResourceRoute
rr of
          ResourceRoute_StaticFile R @SourceExt 'AnyExt
sfR FilePath
_fp ->
            forall a. a -> Maybe a
Just R @SourceExt 'AnyExt
sfR
          ResourceRoute_LML LMLRoute
_ ->
            forall a. Maybe a
Nothing
      SiteRoute_VirtualRoute VirtualRoute
_ -> forall a. Maybe a
Nothing

urlStrategySuffix :: Model -> Text
urlStrategySuffix :: Model -> Text
urlStrategySuffix Model
model =
  case forall (f :: Type -> Type). ModelT f -> UrlStrategy
urlStrategy Model
model of
    UrlStrategy
Ema.UrlDirect -> Text
".html"
    UrlStrategy
Ema.UrlPretty -> Text
""

urlStrategy :: ModelT f -> UrlStrategy
urlStrategy :: forall (f :: Type -> Type). ModelT f -> UrlStrategy
urlStrategy ModelT f
model =
  forall a (f :: Type -> Type).
FromJSON a =>
a -> NonEmpty Text -> LMLRoute -> ModelT f -> a
Model.lookupRouteMeta UrlStrategy
Ema.UrlDirect (Text
"template" forall a. a -> [a] -> NonEmpty a
:| forall x. One x => OneItem x -> x
one Text
"urlStrategy") (forall (f :: Type -> Type). ModelT f -> LMLRoute
M.modelIndexRoute ModelT f
model) ModelT f
model

indexRoute :: SiteRoute
indexRoute :: SiteRoute
indexRoute =
  VirtualRoute -> SiteRoute
SiteRoute_VirtualRoute VirtualRoute
VirtualRoute_Index

tagIndexRoute :: [HT.TagNode] -> SiteRoute
tagIndexRoute :: [TagNode] -> SiteRoute
tagIndexRoute =
  VirtualRoute -> SiteRoute
SiteRoute_VirtualRoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagNode] -> VirtualRoute
VirtualRoute_TagIndex

taskIndexRoute :: SiteRoute
taskIndexRoute :: SiteRoute
taskIndexRoute =
  VirtualRoute -> SiteRoute
SiteRoute_VirtualRoute VirtualRoute
VirtualRoute_TaskIndex