Implement an html documentation generator similar to haddock (#1413) (#…

…1416)
anoma · Jul 28, 2022 · 2532b34 · 2532b34
1 parent c630717
commit 2532b34
Show file tree

Hide file tree

Showing 31 changed files with 1,966 additions and 233 deletions.
diff --git a/app/Commands/Html.hs b/app/Commands/Html.hs
@@ -1,7 +1,7 @@
 module Commands.Html where
 
 import Juvix.Prelude hiding (Doc)
-import Juvix.Syntax.Concrete.Scoped.Pretty.Html
+import Juvix.Syntax.Concrete.Scoped.Pretty.Html hiding (HtmlOptions)
 import Options.Applicative
 
 data HtmlOptions = HtmlOptions

diff --git a/app/Commands/Internal.hs b/app/Commands/Internal.hs
@@ -3,10 +3,12 @@ module Commands.Internal
     module Commands.Internal.MicroJuvix,
     module Commands.Internal.Parse,
     module Commands.Internal.Scope,
+    module Commands.Internal.Doc,
     module Commands.Internal.Termination,
   )
 where
 
+import Commands.Internal.Doc
 import Commands.Internal.MicroJuvix
 import Commands.Internal.Parse
 import Commands.Internal.Scope
@@ -24,6 +26,7 @@ data InternalCommand
   | Parse ParseOptions
   | Scope ScopeOptions
   | Termination TerminationCommand
+  | Doc DocOptions
 
 parseInternalCommand :: Parser InternalCommand
 parseInternalCommand =
@@ -35,12 +38,20 @@ parseInternalCommand =
           commandMiniHaskell,
           commandMonoJuvix,
           commandParse,
+          commandDoc,
           commandScope,
           commandShowRoot,
           commandTermination
         ]
     )
 
+commandDoc :: Mod CommandFields InternalCommand
+commandDoc =
+  command "doc" $
+    info
+      (Doc <$> parseDoc)
+      (progDesc "Generate documentation")
+
 commandHighlight :: Mod CommandFields InternalCommand
 commandHighlight =
   command "highlight" $

diff --git a/app/Commands/Internal/Doc.hs b/app/Commands/Internal/Doc.hs
@@ -0,0 +1,30 @@
+module Commands.Internal.Doc where
+
+import Juvix.Prelude hiding (Doc)
+import Options.Applicative
+
+data DocOptions = DocOptions
+  { _docOutputDir :: FilePath,
+    _docOpen :: Bool
+  }
+
+makeLenses ''DocOptions
+
+parseDoc :: Parser DocOptions
+parseDoc = do
+  _docOutputDir <-
+    option
+      str
+      ( long "output-dir"
+          <> metavar "DIR"
+          <> value "doc"
+          <> showDefault
+          <> help "html output directory"
+          <> action "directory"
+      )
+  _docOpen <-
+    switch
+      ( long "open"
+          <> help "open the documentation after generating it"
+      )
+  pure DocOptions {..}
diff --git a/app/Main.hs b/app/Main.hs
@@ -9,6 +9,7 @@ import Data.HashMap.Strict qualified as HashMap
 import Juvix.Analysis.Scoping.Scoper qualified as Scoper
 import Juvix.Analysis.Termination qualified as Termination
 import Juvix.Analysis.TypeChecking qualified as MicroTyped
+import Juvix.Documentation.Compiler qualified as Doc
 import Juvix.Parsing.Parser qualified as Parser
 import Juvix.Pipeline
 import Juvix.Prelude hiding (Doc)
@@ -19,7 +20,7 @@ import Juvix.Syntax.Abstract.Pretty qualified as Abstract
 import Juvix.Syntax.Concrete.Scoped.Highlight qualified as Highlight
 import Juvix.Syntax.Concrete.Scoped.InfoTable qualified as Scoper
 import Juvix.Syntax.Concrete.Scoped.Pretty qualified as Scoper
-import Juvix.Syntax.Concrete.Scoped.Pretty.Html
+import Juvix.Syntax.Concrete.Scoped.Pretty.Html qualified as Html
 import Juvix.Syntax.MicroJuvix.MicroJuvixArityResult qualified as MicroArity
 import Juvix.Syntax.MicroJuvix.Pretty qualified as Micro
 import Juvix.Syntax.MiniHaskell.Pretty qualified as MiniHaskell
@@ -32,6 +33,7 @@ import Juvix.Translation.ScopedToAbstract qualified as Abstract
 import Juvix.Utils.Version (runDisplayVersion)
 import Options.Applicative
 import System.Environment (getProgName)
+import System.Process qualified as Process
 import Text.Show.Pretty hiding (Html)
 
 juvixYamlFile :: FilePath
@@ -106,7 +108,7 @@ runCommand cmdWithOpts = do
               Html HtmlOptions {..} -> do
                 res <- runPipeline (upToScoping entryPoint)
                 let m = head (res ^. Scoper.resultModules)
-                embed (genHtml Scoper.defaultOptions _htmlRecursive _htmlTheme _htmlOutputDir _htmlPrintMetadata m)
+                embed (Html.genHtml Scoper.defaultOptions _htmlRecursive _htmlTheme _htmlOutputDir _htmlPrintMetadata m)
               (Internal cmd') -> case cmd' of
                 Highlight -> do
                   res <- runPipelineEither (upToScoping entryPoint)
@@ -137,6 +139,14 @@ runCommand cmdWithOpts = do
                         (upToScoping entryPoint)
                   forM_ l $ \s -> do
                     renderStdOut (Scoper.ppOut (mkScopePrettyOptions globalOpts localOpts) s)
+                Doc localOpts -> do
+                  l <-
+                    (^. Scoper.mainModule)
+                      <$> runPipeline
+                        (upToScoping entryPoint)
+                  let docDir = localOpts ^. docOutputDir
+                  Doc.compileModuleHtmlText docDir "proj" l
+                  embed (when (localOpts ^. docOpen) (Process.callProcess "xdg-open" [docDir </> Doc.indexFileName]))
                 MicroJuvix Pretty -> do
                   micro <-
                     head . (^. Micro.resultModules)