module Emanote.Model.Stork (
  renderStorkIndex,
) where

import Control.Monad.Logger (MonadLoggerIO)
import Data.Default (Default (def))
import Data.IxSet.Typed qualified as Ix
import Emanote.Model.Meta (lookupRouteMeta)
import Emanote.Model.Note qualified as N
import Emanote.Model.Stork.Index (
  Config (Config),
  File (File),
  Handling,
  Input (Input),
  readOrBuildStorkIndex,
 )
import Emanote.Model.Title qualified as Tit
import Emanote.Model.Type (Model)
import Emanote.Model.Type qualified as M
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute qualified as SR
import Emanote.Source.Loc qualified as Loc
import Optics.Core ((^.))
import Relude
import System.FilePath ((</>))

renderStorkIndex :: (MonadIO m, MonadLoggerIO m) => Model -> m LByteString
renderStorkIndex :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Model -> m LByteString
renderStorkIndex Model
model = do
  let config :: Config
config = Input -> Config
Config forall a b. (a -> b) -> a -> b
$ [File] -> Handling -> Input
Input (Model -> [File]
storkFiles Model
model) (Model -> Handling
frontmatterHandling Model
model)
  forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
IndexVar -> Config -> m LByteString
readOrBuildStorkIndex (Model
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) IndexVar
M.modelStorkIndex) Config
config

storkFiles :: Model -> [File]
storkFiles :: Model -> [File]
storkFiles Model
model =
  let baseDir :: FilePath
baseDir = Loc -> FilePath
Loc.locPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => LocLayers -> Loc
Loc.primaryLayer forall a b. (a -> b) -> a -> b
$ Model
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) LocLayers
M.modelLayers
   in forall (ixs :: IxList) a. IxSet ixs a -> [a]
Ix.toList (Model
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) (IxSet NoteIxs Note)
M.modelNotes) forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Note
note ->
        FilePath -> Text -> Text -> File
File
          ((FilePath
baseDir </>) forall a b. (a -> b) -> a -> b
$ forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute)
          (HasCallStack => Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute)
          (Title -> Text
Tit.toPlain forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Title
N.noteTitle)

frontmatterHandling :: Model -> Handling
frontmatterHandling :: Model -> Handling
frontmatterHandling Model
model =
  let indexRoute :: LMLRoute
indexRoute = forall (f :: Type -> Type). ModelT f -> LMLRoute
M.modelIndexRoute Model
model
   in forall a (f :: Type -> Type).
FromJSON a =>
a -> NonEmpty Text -> LMLRoute -> ModelT f -> a
lookupRouteMeta forall a. Default a => a
def (Text
"template" forall a. a -> [a] -> NonEmpty a
:| [Text
"stork", Text
"frontmatter-handling"]) LMLRoute
indexRoute Model
model