{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Emanote
  ( run,
    defaultEmanoteConfig,
  )
where

import Control.Monad.Logger (LogLevel (LevelError), runStderrLoggingT, runStdoutLoggingT)
import Control.Monad.Logger.Extras (Logger (Logger), logToStderr, runLoggerLoggingT)
import Control.Monad.Writer.Strict (MonadWriter (tell), WriterT (runWriterT))
import Data.Default (def)
import Data.Dependent.Sum (DSum ((:=>)))
import Data.Map.Strict qualified as Map
import Ema
  ( EmaSite (..),
    IsRoute (..),
    fromPrism_,
    runSiteWithCli,
    toPrism_,
  )
import Ema.CLI qualified
import Ema.Dynamic (Dynamic (Dynamic))
import Emanote.CLI qualified as CLI
import Emanote.Model.Link.Rel (ResolvedRelTarget (..))
import Emanote.Model.Type (modelCompileTailwind)
import Emanote.Model.Type qualified as Model
import Emanote.Pandoc.Renderer
import Emanote.Pandoc.Renderer.Embed qualified as PF
import Emanote.Pandoc.Renderer.Query qualified as PF
import Emanote.Pandoc.Renderer.Url qualified as PF
import Emanote.Prelude (log, logE, logW)
import Emanote.Route.ModelRoute (LMLRoute, lmlRouteCase)
import Emanote.Route.SiteRoute.Class (emanoteGeneratableRoutes, emanoteRouteEncoder)
import Emanote.Route.SiteRoute.Type (SiteRoute)
import Emanote.Source.Dynamic (EmanoteConfig (..), emanoteSiteInput)
import Emanote.View.Common (generatedCssFile)
import Emanote.View.Export qualified as Export
import Emanote.View.Template qualified as View
import Optics.Core ((%), (.~), (^.))
import Relude
import System.FilePath ((</>))
import UnliftIO (MonadUnliftIO)
import Web.Tailwind qualified as Tailwind

instance IsRoute SiteRoute where
  type RouteModel SiteRoute = Model.ModelEma
  routePrism :: RouteModel SiteRoute -> Prism_ FilePath SiteRoute
routePrism = Prism' FilePath SiteRoute -> Prism_ FilePath SiteRoute
forall s a. Prism' s a -> Prism_ s a
toPrism_ (Prism' FilePath SiteRoute -> Prism_ FilePath SiteRoute)
-> (ModelEma -> Prism' FilePath SiteRoute)
-> ModelEma
-> Prism_ FilePath SiteRoute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ModelEma -> Prism' FilePath SiteRoute
ModelEma -> Prism' FilePath SiteRoute
emanoteRouteEncoder
  routeUniverse :: RouteModel SiteRoute -> [SiteRoute]
routeUniverse = RouteModel SiteRoute -> [SiteRoute]
ModelEma -> [SiteRoute]
emanoteGeneratableRoutes

instance EmaSite SiteRoute where
  type SiteArg SiteRoute = EmanoteConfig
  siteInput :: forall (m :: Type -> Type).
(MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action
-> SiteArg SiteRoute -> m (Dynamic m (RouteModel SiteRoute))
siteInput = Some @Type Action
-> SiteArg SiteRoute -> m (Dynamic m (RouteModel SiteRoute))
forall (m :: Type -> Type).
(MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action -> EmanoteConfig -> m (Dynamic m ModelEma)
emanoteSiteInput
  siteOutput :: forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Prism' FilePath SiteRoute
-> RouteModel SiteRoute -> SiteRoute -> m (SiteOutput SiteRoute)
siteOutput = Prism' FilePath SiteRoute
-> RouteModel SiteRoute -> SiteRoute -> m (SiteOutput SiteRoute)
forall (m :: Type -> Type).
(MonadIO m, MonadLoggerIO m) =>
Prism' FilePath SiteRoute
-> ModelEma -> SiteRoute -> m (Asset LByteString)
View.emanoteSiteOutput

defaultEmanoteConfig :: CLI.Cli -> EmanoteConfig
defaultEmanoteConfig :: Cli -> EmanoteConfig
defaultEmanoteConfig Cli
cli =
  Cli
-> (Note -> Note)
-> EmanotePandocRenderers Model LMLRoute
-> Bool
-> EmanoteConfig
EmanoteConfig Cli
cli Note -> Note
forall a. a -> a
id EmanotePandocRenderers Model LMLRoute
defaultEmanotePandocRenderers Bool
False

run :: EmanoteConfig -> IO ()
run :: EmanoteConfig -> IO ()
run cfg :: EmanoteConfig
cfg@EmanoteConfig {Bool
EmanotePandocRenderers Model LMLRoute
Cli
Note -> Note
_emanoteCompileTailwind :: EmanoteConfig -> Bool
_emanoteConfigPandocRenderers :: EmanoteConfig -> EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: EmanoteConfig -> Note -> Note
_emanoteConfigCli :: EmanoteConfig -> Cli
_emanoteCompileTailwind :: Bool
_emanoteConfigPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: Note -> Note
_emanoteConfigCli :: Cli
..} = do
  case Cli -> Cmd
CLI.cmd Cli
_emanoteConfigCli of
    CLI.Cmd_Ema Cli
emaCli ->
      forall r.
(Show r, Eq r, EmaStaticSite r) =>
Cli -> SiteArg r -> IO (RouteModel r, DSum @Type Action Identity)
Ema.runSiteWithCli @SiteRoute Cli
emaCli SiteArg SiteRoute
EmanoteConfig
cfg
        IO (ModelEma, DSum @Type Action Identity)
-> ((ModelEma, DSum @Type Action Identity) -> IO ()) -> IO ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= EmanoteConfig -> (ModelEma, DSum @Type Action Identity) -> IO ()
postRun EmanoteConfig
cfg
    Cmd
CLI.Cmd_Export -> do
      Dynamic (ModelEma -> Model
unModelEma -> Model
model0, (ModelEma -> LoggingT IO ()) -> LoggingT IO ()
_) <-
        (LoggingT IO (Dynamic (LoggingT IO) ModelEma)
 -> Logger -> IO (Dynamic (LoggingT IO) ModelEma))
-> Logger
-> LoggingT IO (Dynamic (LoggingT IO) ModelEma)
-> IO (Dynamic (LoggingT IO) ModelEma)
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO (Dynamic (LoggingT IO) ModelEma)
-> Logger -> IO (Dynamic (LoggingT IO) ModelEma)
forall (m :: Type -> Type) a. LoggingT m a -> Logger -> m a
runLoggerLoggingT Logger
oneOffLogger (LoggingT IO (Dynamic (LoggingT IO) ModelEma)
 -> IO (Dynamic (LoggingT IO) ModelEma))
-> LoggingT IO (Dynamic (LoggingT IO) ModelEma)
-> IO (Dynamic (LoggingT IO) ModelEma)
forall a b. (a -> b) -> a -> b
$
          forall r (m :: Type -> Type).
(EmaSite r, MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action -> SiteArg r -> m (Dynamic m (RouteModel r))
siteInput @SiteRoute (Cli -> Some @Type Action
Ema.CLI.action Cli
forall a. Default a => a
def) SiteArg SiteRoute
EmanoteConfig
cfg
      LByteString -> IO ()
forall (m :: Type -> Type). MonadIO m => LByteString -> m ()
putLBSLn (LByteString -> IO ()) -> LByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Model -> LByteString
Export.renderGraphExport Model
model0
  where
    -- A logger suited for running one-off commands.
    oneOffLogger :: Logger
oneOffLogger =
      Logger
logToStderr
        Logger -> (Logger -> Logger) -> Logger
forall a b. a -> (a -> b) -> b
& LogLevel -> Logger -> Logger
allowLogLevelFrom LogLevel
LevelError
      where
        allowLogLevelFrom :: LogLevel -> Logger -> Logger
        allowLogLevelFrom :: LogLevel -> Logger -> Logger
allowLogLevelFrom LogLevel
minLevel (Logger LogF
f) = LogF -> Logger
Logger (LogF -> Logger) -> LogF -> Logger
forall a b. (a -> b) -> a -> b
$ \Loc
loc Text
src LogLevel
level LogStr
msg ->
          if LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
minLevel
            then LogF
f Loc
loc Text
src LogLevel
level LogStr
msg
            else IO ()
forall (f :: Type -> Type). Applicative f => f ()
pass

postRun :: EmanoteConfig -> (Model.ModelEma, DSum Ema.CLI.Action Identity) -> IO ()
postRun :: EmanoteConfig -> (ModelEma, DSum @Type Action Identity) -> IO ()
postRun EmanoteConfig {Bool
EmanotePandocRenderers Model LMLRoute
Cli
Note -> Note
_emanoteCompileTailwind :: Bool
_emanoteConfigPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: Note -> Note
_emanoteConfigCli :: Cli
_emanoteCompileTailwind :: EmanoteConfig -> Bool
_emanoteConfigPandocRenderers :: EmanoteConfig -> EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: EmanoteConfig -> Note -> Note
_emanoteConfigCli :: EmanoteConfig -> Cli
..} = \case
  (ModelEma -> Model
unModelEma -> Model
model0, Ema.CLI.Generate FilePath
outPath :=> Identity a
genPaths) -> do
    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Model
model0 Model -> Optic' A_Lens NoIx Model Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model Bool
forall (encF :: Type -> Type). Lens' (ModelT encF) Bool
modelCompileTailwind) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> [FilePath] -> IO ()
forall (m :: Type -> Type).
MonadUnliftIO m =>
FilePath -> [FilePath] -> m ()
compileTailwindCss (FilePath
outPath FilePath -> FilePath -> FilePath
</> FilePath
generatedCssFile) a
[FilePath]
genPaths
    Cli -> Map LMLRoute [Link] -> IO ()
checkBrokenLinks Cli
_emanoteConfigCli (Map LMLRoute [Link] -> IO ()) -> Map LMLRoute [Link] -> IO ()
forall a b. (a -> b) -> a -> b
$ Model -> Map LMLRoute [Link]
Export.modelRels Model
model0
    Map LMLRoute [Text] -> IO ()
checkBadMarkdownFiles (Map LMLRoute [Text] -> IO ()) -> Map LMLRoute [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Model -> Map LMLRoute [Text]
Model.modelNoteErrors Model
model0
  (ModelEma, DSum @Type Action Identity)
_ ->
    IO ()
forall (f :: Type -> Type). Applicative f => f ()
pass

unModelEma :: Model.ModelEma -> Model.Model
unModelEma :: ModelEma -> Model
unModelEma ModelEma
m = Prism' FilePath SiteRoute -> ModelEma -> Model
Model.withRoutePrism (Prism_ FilePath SiteRoute -> Prism' FilePath SiteRoute
forall s a. Prism_ s a -> Prism' s a
fromPrism_ (Prism_ FilePath SiteRoute -> Prism' FilePath SiteRoute)
-> Prism_ FilePath SiteRoute -> Prism' FilePath SiteRoute
forall a b. (a -> b) -> a -> b
$ forall r. IsRoute r => RouteModel r -> Prism_ FilePath r
routePrism @SiteRoute RouteModel SiteRoute
ModelEma
m) ModelEma
m

checkBadMarkdownFiles :: Map LMLRoute [Text] -> IO ()
checkBadMarkdownFiles :: Map LMLRoute [Text] -> IO ()
checkBadMarkdownFiles Map LMLRoute [Text]
noteErrs = LoggingT IO () -> IO ()
forall (m :: Type -> Type) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [(LMLRoute, [Text])]
-> ((LMLRoute, [Text]) -> LoggingT IO ()) -> LoggingT IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map LMLRoute [Text] -> [(LMLRoute, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map LMLRoute [Text]
noteErrs) (((LMLRoute, [Text]) -> LoggingT IO ()) -> LoggingT IO ())
-> ((LMLRoute, [Text]) -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \(LMLRoute
noteRoute, [Text]
errs) -> do
    Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logW (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Bad markdown file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LMLRoute -> Text
forall b a. (Show a, IsString b) => a -> b
show LMLRoute
noteRoute
    [Text] -> (Text -> LoggingT IO ()) -> LoggingT IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
errs ((Text -> LoggingT IO ()) -> LoggingT IO ())
-> (Text -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \Text
err -> do
      Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logE (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
  Bool -> LoggingT IO () -> LoggingT IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Map LMLRoute [Text] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null Map LMLRoute [Text]
noteErrs) (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logE Text
"Errors found."
    LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => m a
exitFailure

checkBrokenLinks :: CLI.Cli -> Map LMLRoute [Export.Link] -> IO ()
checkBrokenLinks :: Cli -> Map LMLRoute [Link] -> IO ()
checkBrokenLinks Cli
cli Map LMLRoute [Link]
modelRels = LoggingT IO () -> IO ()
forall (m :: Type -> Type) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ((), Sum Int
res :: Sum Int) <- WriterT (Sum Int) (LoggingT IO) () -> LoggingT IO ((), Sum Int)
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (Sum Int) (LoggingT IO) () -> LoggingT IO ((), Sum Int))
-> WriterT (Sum Int) (LoggingT IO) () -> LoggingT IO ((), Sum Int)
forall a b. (a -> b) -> a -> b
$
    [(LMLRoute, [Link])]
-> ((LMLRoute, [Link]) -> WriterT (Sum Int) (LoggingT IO) ())
-> WriterT (Sum Int) (LoggingT IO) ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map LMLRoute [Link] -> [(LMLRoute, [Link])]
forall k a. Map k a -> [(k, a)]
Map.toList Map LMLRoute [Link]
modelRels) (((LMLRoute, [Link]) -> WriterT (Sum Int) (LoggingT IO) ())
 -> WriterT (Sum Int) (LoggingT IO) ())
-> ((LMLRoute, [Link]) -> WriterT (Sum Int) (LoggingT IO) ())
-> WriterT (Sum Int) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ \(LMLRoute
noteRoute, [Link]
rels) ->
      [Link]
-> (Link -> WriterT (Sum Int) (LoggingT IO) ())
-> WriterT (Sum Int) (LoggingT IO) ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Link] -> [Link]
forall a. Ord a => [a] -> [a]
sortNub [Link]
rels) ((Link -> WriterT (Sum Int) (LoggingT IO) ())
 -> WriterT (Sum Int) (LoggingT IO) ())
-> (Link -> WriterT (Sum Int) (LoggingT IO) ())
-> WriterT (Sum Int) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ \(Export.Link UnresolvedRelTarget
urt ResolvedRelTarget Text
rrt) ->
        case ResolvedRelTarget Text
rrt of
          RRTFound Text
_ -> WriterT (Sum Int) (LoggingT IO) ()
forall (f :: Type -> Type). Applicative f => f ()
pass
          ResolvedRelTarget Text
RRTMissing -> do
            Text -> WriterT (Sum Int) (LoggingT IO) ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logW (Text -> WriterT (Sum Int) (LoggingT IO) ())
-> Text -> WriterT (Sum Int) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ Text
"Broken link: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Either (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
-> Text
forall b a. (Show a, IsString b) => a -> b
show (LMLRoute
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
lmlRouteCase LMLRoute
noteRoute) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UnresolvedRelTarget -> Text
forall b a. (Show a, IsString b) => a -> b
show UnresolvedRelTarget
urt
            Sum Int -> WriterT (Sum Int) (LoggingT IO) ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell Sum Int
1
          RRTAmbiguous NonEmpty Text
ls -> do
            Text -> WriterT (Sum Int) (LoggingT IO) ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logW (Text -> WriterT (Sum Int) (LoggingT IO) ())
-> Text -> WriterT (Sum Int) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ Text
"Ambiguous link: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Either (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
-> Text
forall b a. (Show a, IsString b) => a -> b
show (LMLRoute
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
lmlRouteCase LMLRoute
noteRoute) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UnresolvedRelTarget -> Text
forall b a. (Show a, IsString b) => a -> b
show UnresolvedRelTarget
urt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ambiguities: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> Text
forall b a. (Show a, IsString b) => a -> b
show NonEmpty Text
ls
            Sum Int -> WriterT (Sum Int) (LoggingT IO) ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell Sum Int
1
  if Sum Int
res Sum Int -> Sum Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sum Int
0
    then do
      Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
log Text
"No broken links detected."
    else Bool -> LoggingT IO () -> LoggingT IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Cli -> Bool
CLI.allowBrokenLinks Cli
cli) (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ do
      Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
logE (Text -> LoggingT IO ()) -> Text -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
res) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" broken links! Emanote generated the site, but the generated site has broken links."
      Text -> LoggingT IO ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
log Text
"(Tip: use `--allow-broken-links` to ignore this check.)"
      LoggingT IO ()
forall (m :: Type -> Type) a. MonadIO m => m a
exitFailure

compileTailwindCss :: MonadUnliftIO m => FilePath -> [FilePath] -> m ()
compileTailwindCss :: forall (m :: Type -> Type).
MonadUnliftIO m =>
FilePath -> [FilePath] -> m ()
compileTailwindCss FilePath
cssPath [FilePath]
genPaths = do
  LoggingT m () -> m ()
forall (m :: Type -> Type) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT m () -> m ()) -> LoggingT m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> LoggingT m ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
log (Text -> LoggingT m ()) -> Text -> LoggingT m ()
forall a b. (a -> b) -> a -> b
$ Text
"Running Tailwind CSS v3 compiler to generate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
cssPath
    Tailwind -> LoggingT m ()
forall (m :: Type -> Type).
(MonadUnliftIO m, MonadLogger m, HasCallStack) =>
Tailwind -> m ()
Tailwind.runTailwind (Tailwind -> LoggingT m ()) -> Tailwind -> LoggingT m ()
forall a b. (a -> b) -> a -> b
$
      Tailwind
forall a. Default a => a
def
        Tailwind -> (Tailwind -> Tailwind) -> Tailwind
forall a b. a -> (a -> b) -> b
& Lens' Tailwind TailwindConfig
Tailwind.tailwindConfig Lens' Tailwind TailwindConfig
-> Optic
     An_Iso NoIx TailwindConfig TailwindConfig [FilePath] [FilePath]
-> Optic A_Lens NoIx Tailwind Tailwind [FilePath] [FilePath]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso NoIx TailwindConfig TailwindConfig [FilePath] [FilePath]
Tailwind.tailwindConfigContent Optic A_Lens NoIx Tailwind Tailwind [FilePath] [FilePath]
-> [FilePath] -> Tailwind -> Tailwind
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [FilePath]
genPaths
        Tailwind -> (Tailwind -> Tailwind) -> Tailwind
forall a b. a -> (a -> b) -> b
& Lens' Tailwind FilePath
Tailwind.tailwindOutput Lens' Tailwind FilePath -> FilePath -> Tailwind -> Tailwind
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ FilePath
cssPath
        Tailwind -> (Tailwind -> Tailwind) -> Tailwind
forall a b. a -> (a -> b) -> b
& Lens' Tailwind Mode
Tailwind.tailwindMode Lens' Tailwind Mode -> Mode -> Tailwind -> Tailwind
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Mode
Tailwind.Production

defaultEmanotePandocRenderers :: EmanotePandocRenderers Model.Model LMLRoute
defaultEmanotePandocRenderers :: EmanotePandocRenderers Model LMLRoute
defaultEmanotePandocRenderers =
  let blockRenderers :: PandocRenderers Model LMLRoute
blockRenderers =
        [PandocInlineRenderer Model LMLRoute]
-> [PandocBlockRenderer Model LMLRoute]
-> PandocRenderers Model LMLRoute
forall model route.
[PandocInlineRenderer model route]
-> [PandocBlockRenderer model route] -> PandocRenderers model route
PandocRenderers
          [ PandocInlineRenderer Model LMLRoute
PF.embedInlineWikiLinkResolvingSplice, -- embedInlineWikiLinkResolvingSplice should be first to recognize inline Link elements first
            PandocInlineRenderer Model LMLRoute
PF.urlResolvingSplice
          ]
          [ PandocBlockRenderer Model LMLRoute
PF.embedBlockWikiLinkResolvingSplice,
            PandocBlockRenderer Model LMLRoute
PF.embedBlockRegularLinkResolvingSplice,
            PandocBlockRenderer Model LMLRoute
PF.queryResolvingSplice
          ]
      inlineRenderers :: PandocRenderers Model LMLRoute
inlineRenderers =
        [PandocInlineRenderer Model LMLRoute]
-> [PandocBlockRenderer Model LMLRoute]
-> PandocRenderers Model LMLRoute
forall model route.
[PandocInlineRenderer model route]
-> [PandocBlockRenderer model route] -> PandocRenderers model route
PandocRenderers
          [ PandocInlineRenderer Model LMLRoute
PF.embedInlineWikiLinkResolvingSplice, -- embedInlineWikiLinkResolvingSplice should be first to recognize inline Link elements first
            PandocInlineRenderer Model LMLRoute
PF.urlResolvingSplice
          ]
          [PandocBlockRenderer Model LMLRoute]
forall a. Monoid a => a
mempty
      linkInlineRenderers :: PandocRenderers Model LMLRoute
linkInlineRenderers =
        [PandocInlineRenderer Model LMLRoute]
-> [PandocBlockRenderer Model LMLRoute]
-> PandocRenderers Model LMLRoute
forall model route.
[PandocInlineRenderer model route]
-> [PandocBlockRenderer model route] -> PandocRenderers model route
PandocRenderers
          [ PandocInlineRenderer Model LMLRoute
PF.plainifyWikiLinkSplice
          ]
          [PandocBlockRenderer Model LMLRoute]
forall a. Monoid a => a
mempty
   in EmanotePandocRenderers :: forall a r.
PandocRenderers a r
-> PandocRenderers a r
-> PandocRenderers a r
-> EmanotePandocRenderers a r
EmanotePandocRenderers {PandocRenderers Model LMLRoute
linkInlineRenderers :: PandocRenderers Model LMLRoute
inlineRenderers :: PandocRenderers Model LMLRoute
blockRenderers :: PandocRenderers Model LMLRoute
linkInlineRenderers :: PandocRenderers Model LMLRoute
inlineRenderers :: PandocRenderers Model LMLRoute
blockRenderers :: PandocRenderers Model LMLRoute
..}