mirror of
https://github.com/anoma/juvix.git
synced 2024-12-04 17:07:28 +03:00
0e8ccb7db2
The judoc examples feature is currently unused. This feature was added in https://github.com/anoma/juvix/pull/1442 Keeping support for this feature adds a cost to HTML generation. We are removing this to improve the performance of `juvix html`. To just render the HTML documentation we only require the scoper result from the pipeline. To support the examples we need the type checking result. The cost is significant in larger projects as the pipeline is run for each import. Part of https://github.com/anoma/juvix/issues/2744
90 lines
3.7 KiB
Haskell
90 lines
3.7 KiB
Haskell
module Commands.Html where
|
|
|
|
import Commands.Base
|
|
import Commands.Html.Options
|
|
import Juvix.Compiler.Backend.Html.Translation.FromTyped (JudocArgs (..))
|
|
import Juvix.Compiler.Backend.Html.Translation.FromTyped qualified as Html
|
|
import Juvix.Compiler.Backend.Html.Translation.FromTyped.Source
|
|
( GenSourceHtmlArgs (..),
|
|
)
|
|
import Juvix.Compiler.Concrete.Pretty qualified as Concrete
|
|
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
|
|
import Juvix.Compiler.Internal.Translation
|
|
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context (resultInternal)
|
|
import Juvix.Extra.Process
|
|
import System.Process qualified as Process
|
|
|
|
runGenOnlySourceHtml :: (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r ()
|
|
runGenOnlySourceHtml HtmlOptions {..} = do
|
|
res <- runPipelineNoOptions _htmlInputFile upToScoping
|
|
let m = res ^. Scoper.resultModule
|
|
outputDir <- fromAppPathDir _htmlOutputDir
|
|
liftIO $
|
|
Html.genSourceHtml
|
|
GenSourceHtmlArgs
|
|
{ _genSourceHtmlArgsAssetsDir = _htmlAssetsPrefix,
|
|
_genSourceHtmlArgsHtmlKind = Html.HtmlOnly,
|
|
_genSourceHtmlArgsOnlyCode = _htmlOnlyCode,
|
|
_genSourceHtmlArgsParamBase = "",
|
|
_genSourceHtmlArgsUrlPrefix = _htmlUrlPrefix,
|
|
_genSourceHtmlArgsIdPrefix = _htmlIdPrefix,
|
|
_genSourceHtmlArgsNoPath = _htmlNoPath,
|
|
_genSourceHtmlArgsFolderStructure = _htmlFolderStructure,
|
|
_genSourceHtmlArgsExt = _htmlExt,
|
|
_genSourceHtmlArgsStripPrefix = _htmlStripPrefix,
|
|
_genSourceHtmlArgsConcreteOpts = Concrete.defaultOptions,
|
|
_genSourceHtmlArgsModule = m,
|
|
_genSourceHtmlArgsComments = Scoper.getScoperResultComments res,
|
|
_genSourceHtmlArgsOutputDir = outputDir,
|
|
_genSourceHtmlArgsNoFooter = _htmlNoFooter,
|
|
_genSourceHtmlArgsNonRecursive = _htmlNonRecursive,
|
|
_genSourceHtmlArgsTheme = _htmlTheme
|
|
}
|
|
|
|
resultToJudocCtx :: InternalTypedResult -> Html.JudocCtx
|
|
resultToJudocCtx res =
|
|
Html.JudocCtx
|
|
{ _judocCtxComments = Scoper.getScoperResultComments sres,
|
|
_judocCtxTopModules = [sres ^. Scoper.resultModule]
|
|
}
|
|
where
|
|
sres = res ^. resultInternal . resultScoper
|
|
|
|
runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r ()
|
|
runCommand HtmlOptions {..}
|
|
| _htmlOnlySource = runGenOnlySourceHtml HtmlOptions {..}
|
|
| otherwise = do
|
|
entry <- getEntryPoint _htmlInputFile
|
|
(r, rs) <- runPipelineHtml _htmlNonRecursive _htmlInputFile
|
|
outputDir <- fromAppPathDir _htmlOutputDir
|
|
let ctx = resultToJudocCtx r <> mconcatMap resultToJudocCtx rs
|
|
Html.genJudocHtml
|
|
entry
|
|
JudocArgs
|
|
{ _judocArgsAssetsPrefix = _htmlAssetsPrefix,
|
|
_judocArgsBaseName = "proj",
|
|
_judocArgsCtx = ctx,
|
|
_judocArgsMainModule = r ^. resultInternal . resultScoper . Scoper.resultModule,
|
|
_judocArgsOutputDir = outputDir,
|
|
_judocArgsUrlPrefix = _htmlUrlPrefix,
|
|
_judocArgsIdPrefix = _htmlIdPrefix,
|
|
_judocArgsTheme = _htmlTheme,
|
|
_judocArgsNonRecursive = _htmlNonRecursive,
|
|
_judocArgsNoFooter = _htmlNoFooter,
|
|
_judocArgsNoPath = _htmlNoPath,
|
|
_judocArgsExt = _htmlExt,
|
|
_judocArgsStripPrefix = _htmlStripPrefix,
|
|
_judocArgsFolderStructure = _htmlFolderStructure
|
|
}
|
|
when _htmlOpen $ case openCmd of
|
|
Nothing -> say "Could not recognize the 'open' command for your OS"
|
|
Just opencmd ->
|
|
liftIO
|
|
. void
|
|
$ Process.spawnProcess
|
|
opencmd
|
|
[ toFilePath
|
|
( outputDir <//> Html.indexFileName
|
|
)
|
|
]
|