Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Recursive markdown generation #3268

Merged
merged 5 commits into from
Jan 15, 2025
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
process markdown recursively
janmasrovira committed Jan 15, 2025
commit 35de1e9be786474fd283f372dd0118b511cfd606
14 changes: 14 additions & 0 deletions app/App.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,7 @@ module App where
import CommonOptions
import Data.ByteString qualified as ByteString
import GlobalOptions
import Juvix.Compiler.Backend.Markdown.Error
import Juvix.Compiler.Internal.Translation (InternalTypedResult)
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
import Juvix.Compiler.Pipeline.Loader.PathResolver
@@ -264,6 +265,16 @@ runPipeline opts input_ =
runPipelineLogger opts input_
. inject

runPipelineRecursive ::
forall r.
(Members '[App, EmbedIO, Logger, TaggedLock] r) =>
Maybe (AppPath File) ->
Sem r (InternalTypedResult, [InternalTypedResult])
runPipelineRecursive input_ = do
args <- askArgs
entry <- getEntryPoint' args input_
runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError

runPipelineHtml ::
(Members '[App, EmbedIO, Logger, TaggedLock] r) =>
Bool ->
@@ -318,6 +329,9 @@ getRight = either appError return
runAppError :: forall e r a. (AppError e, Members '[App] r) => Sem (Error e ': r) a -> Sem r a
runAppError = runErrorNoCallStackWith appError

instance AppError MarkdownBackendError where
appError = appError . JuvixError

instance AppError ParserError where
appError = appError . JuvixError

41 changes: 20 additions & 21 deletions app/Commands/Html.hs
Original file line number Diff line number Diff line change
@@ -19,27 +19,26 @@ runGenOnlySourceHtml HtmlOptions {..} = do
res <- runPipelineNoOptions _htmlInputFile upToScopingEntry
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
}
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 =
122 changes: 76 additions & 46 deletions app/Commands/Markdown.hs
Original file line number Diff line number Diff line change
@@ -1,62 +1,92 @@
module Commands.Markdown where
module Commands.Markdown (runCommand) where

import Commands.Base
import Commands.Markdown.Options
import Data.Text.IO qualified as Text
import Juvix.Compiler.Backend.Markdown.Error
import Juvix.Compiler.Backend.Markdown.Translation.FromTyped.Source
import Juvix.Compiler.Backend.Markdown.Translation.FromTyped.Source qualified as MK
import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
import Juvix.Compiler.Concrete.Language qualified as Concrete
import Juvix.Compiler.Concrete.Pretty qualified as Concrete
import Juvix.Compiler.Concrete.Language as Concrete
import Juvix.Compiler.Concrete.Pretty as Concrete
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.Base
import Juvix.Extra.Assets (writeAssets)

data Mode
= Project (Path Abs Dir)
| SingleFile (Path Abs File)

getMode :: forall r. (Members '[App, EmbedIO] r) => Maybe (AppPath FileOrDir) -> Sem r Mode
getMode mf = runFailDefaultM projectMode $ do
optFile <- failMaybe mf
either SingleFile Project <$> fromAppPathFileOrDir optFile
where
projectMode :: Sem r Mode
projectMode = Project . (^. rootRootDir) <$> askRoot

runCommand ::
forall r.
(Members AppEffects r) =>
MarkdownOptions ->
Sem r ()
runCommand opts = do
let inputFile = opts ^. markdownInputFile
scopedM <- runPipelineNoOptions inputFile upToScopingEntry
let m = scopedM ^. Scoper.resultModule
outputDir <- fromAppPathDir (opts ^. markdownOutputDir)
let res =
MK.fromJuvixMarkdown'
ProcessJuvixBlocksArgs
{ _processJuvixBlocksArgsConcreteOpts = Concrete.defaultOptions,
_processJuvixBlocksArgsUrlPrefix = opts ^. markdownUrlPrefix,
_processJuvixBlocksArgsIdPrefix =
opts ^. markdownIdPrefix,
_processJuvixBlocksArgsNoPath =
opts ^. markdownNoPath,
_processJuvixBlocksArgsExt =
opts ^. markdownExt,
_processJuvixBlocksArgsStripPrefix =
opts ^. markdownStripPrefix,
_processJuvixBlocksArgsComments = Scoper.getScoperResultComments scopedM,
_processJuvixBlocksArgsModule = m,
_processJuvixBlocksArgsOutputDir = outputDir,
_processJuvixBlocksArgsFolderStructure =
opts ^. markdownFolderStructure
}
case res of
Left err -> exitJuvixError (JuvixError err)
Right md
| opts ^. markdownStdout -> liftIO . putStrLn $ md
| otherwise -> do
ensureDir outputDir
when (opts ^. markdownWriteAssets) $
liftIO $
writeAssets outputDir
mode :: Mode <- getMode (opts ^. markdownInputFile)
let inputFile = case mode of
Project {} -> Nothing
SingleFile f ->
Just
AppPath
{ _pathPath = preFileFromAbs f,
_pathIsInput = True
}
let shouldRecurse :: ImportNode -> Bool
shouldRecurse node = case mode of
Project p -> p == node ^. importNodePackageRoot
SingleFile {} -> False
(scopedM, others) :: (Scoper.ScoperResult, [Scoper.ScoperResult]) <-
runPipelineEither () inputFile (processRecursivelyUpTo shouldRecurse upToScopingEntry)
>>= fmap ((^. pipelineResult) . snd) . getRight
mapM_ goScoperResult (scopedM : others)
where
goScoperResult :: Scoper.ScoperResult -> Sem r ()
goScoperResult scopedM = do
let m :: Module 'Scoped 'ModuleTop = scopedM ^. Scoper.resultModule
outputDir <- fromAppPathDir (opts ^. markdownOutputDir)
let args =
ProcessJuvixBlocksArgs
{ _processJuvixBlocksArgsConcreteOpts = Concrete.defaultOptions,
_processJuvixBlocksArgsUrlPrefix = opts ^. markdownUrlPrefix,
_processJuvixBlocksArgsIdPrefix =
opts ^. markdownIdPrefix,
_processJuvixBlocksArgsNoPath =
opts ^. markdownNoPath,
_processJuvixBlocksArgsExt =
opts ^. markdownExt,
_processJuvixBlocksArgsStripPrefix =
opts ^. markdownStripPrefix,
_processJuvixBlocksArgsComments = Scoper.getScoperResultComments scopedM,
_processJuvixBlocksArgsModule = m,
_processJuvixBlocksArgsOutputDir = outputDir,
_processJuvixBlocksArgsFolderStructure =
opts ^. markdownFolderStructure
}

md :: Text <- runAppError @MarkdownBackendError (MK.fromJuvixMarkdown args)
if
| opts ^. markdownStdout -> putStrLn md
| otherwise -> do
ensureDir outputDir
when (opts ^. markdownWriteAssets) $
writeAssets outputDir

let mdFile :: Path Rel File
mdFile =
relFile
( Concrete.topModulePathToDottedPath
(m ^. Concrete.modulePath . S.nameConcrete)
<.> markdownFileExt
)
absPath :: Path Abs File
absPath = outputDir <//> mdFile
let mdFile :: Path Rel File
mdFile =
relFile
( Concrete.topModulePathToDottedPath
(m ^. Concrete.modulePath . S.nameConcrete)
<.> markdownFileExt
)
absPath :: Path Abs File
absPath = outputDir <//> mdFile

liftIO $ Text.writeFile (toFilePath absPath) md
writeFileEnsureLn absPath md
13 changes: 11 additions & 2 deletions app/Commands/Markdown/Options.hs
Original file line number Diff line number Diff line change
@@ -3,7 +3,7 @@ module Commands.Markdown.Options where
import CommonOptions

data MarkdownOptions = MarkdownOptions
{ _markdownInputFile :: Maybe (AppPath File),
{ _markdownInputFile :: Maybe (AppPath FileOrDir),
_markdownOutputDir :: AppPath Dir,
_markdownUrlPrefix :: Text,
_markdownIdPrefix :: Text,
@@ -33,7 +33,16 @@ parseJuvixMarkdown = do
<> showDefault
<> help "Prefix used for HTML element IDs"
)
_markdownInputFile <- optional (parseInputFile FileExtJuvixMarkdown)
_markdownInputFile <-
optional
( argument
someInputPreFileOrDirOpt
( metavar "JUVIX_MD_FILE_OR_PROJECT"
<> help ("Path to a " <> show FileExtJuvixMarkdown <> " file or to a directory containing a Juvix project.")
<> completer (extCompleter FileExtJuvixMarkdown)
<> action "directory"
)
)
_markdownOutputDir <-
parseGenericOutputDir
( value "markdown"
19 changes: 14 additions & 5 deletions app/CommonOptions.hs
Original file line number Diff line number Diff line change
@@ -22,7 +22,6 @@ import Juvix.Compiler.Tree.Data.TransformationId.Parser qualified as Tree
import Juvix.Data.Field
import Juvix.Data.Keyword.All qualified as Kw
import Juvix.Prelude
import Juvix.Prelude as Juvix
import Juvix.Prelude.Parsing qualified as P
import Juvix.Prelude.Pretty hiding (group, list)
import Options.Applicative hiding (helpDoc)
@@ -50,7 +49,7 @@ parseInputFilesMod :: NonEmpty FileExt -> Mod ArgumentFields (Prepath File) -> P
parseInputFilesMod exts' mods = do
let exts = NonEmpty.toList exts'
mvars = intercalate "|" (map toMetavar exts)
dotExts = intercalate ", " (map Prelude.show exts)
dotExts = intercalate ", " (map show exts)
helpMsg = "Path to a " <> dotExts <> " file"
completers = foldMap (completer . extCompleter) exts
_pathPath <-
@@ -130,7 +129,7 @@ parseNumThreads = do
<> value defaultNumThreads
<> showDefault
<> help "Number of physical threads to run"
<> completer (listCompleter (Juvix.show NumThreadsAuto : [Juvix.show j | j <- [1 .. numCapabilities]]))
<> completer (listCompleter (show NumThreadsAuto : [show j | j <- [1 .. numCapabilities]]))
)

parseProgramInputFile :: Parser (AppPath File)
@@ -186,6 +185,16 @@ parseGenericOutputDir m = do
somePreDirOpt :: ReadM (Prepath Dir)
somePreDirOpt = mkPrepath <$> str

someInputPreFileOrDirOpt :: ReadM (AppPath FileOrDir)
someInputPreFileOrDirOpt = mkInputAppPath . mkPrepath <$> str
where
mkInputAppPath :: Prepath f -> AppPath f
mkInputAppPath p =
AppPath
{ _pathPath = p,
_pathIsInput = True
}

somePreFileOrDirOpt :: ReadM (Prepath FileOrDir)
somePreFileOrDirOpt = mkPrepath <$> str

@@ -240,13 +249,13 @@ enumReader :: forall a. (Bounded a, Enum a, Show a) => Proxy a -> ReadM a
enumReader _ = eitherReader $ \val ->
case lookup val assocs of
Just x -> return x
Nothing -> Left ("Invalid value " <> val <> ". Valid values are: " <> (Juvix.show (allElements @a)))
Nothing -> Left ("Invalid value " <> val <> ". Valid values are: " <> (show (allElements @a)))
where
assocs :: [(String, a)]
assocs = [(Prelude.show x, x) | x <- allElements @a]

enumCompleter :: forall a. (Bounded a, Enum a, Show a) => Proxy a -> Completer
enumCompleter _ = listCompleter [Juvix.show e | e <- allElements @a]
enumCompleter _ = listCompleter [show e | e <- allElements @a]

extCompleter :: FileExt -> Completer
extCompleter ext = mkCompleter $ \word -> do
31 changes: 16 additions & 15 deletions src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs
Original file line number Diff line number Diff line change
@@ -78,7 +78,7 @@ data GenModuleTextArgs = GenModuleTextArgs

makeLenses ''GenModuleTextArgs

genSourceHtml :: GenSourceHtmlArgs -> IO ()
genSourceHtml :: forall m. (MonadMask m, MonadIO m) => GenSourceHtmlArgs -> m ()
genSourceHtml o@GenSourceHtmlArgs {..} = do
let outputDir = _genSourceHtmlArgsOutputDir
ensureDir outputDir
@@ -113,24 +113,25 @@ genSourceHtml o@GenSourceHtmlArgs {..} = do
topModules :: HashMap NameId (Module 'Scoped 'ModuleTop)
topModules = HashMap.fromList [(entry ^. modulePath . S.nameId, entry)]

outputModule :: Module 'Scoped 'ModuleTop -> IO ()
outputModule :: Module 'Scoped 'ModuleTop -> m ()
outputModule m = do
ensureDir (parent outputFile)
let absPath = (htmlOptions ^. htmlOptionsOutputDir) <//> outputFile
putStrLn $ "Writing " <> pack (toFilePath absPath)
utc <- getCurrentTime
Text.writeFile
(toFilePath outputFile)
( run
. runReader htmlOptions
$ genModuleText
GenModuleTextArgs
{ _genModuleTextArgsConcreteOpts = o ^. genSourceHtmlArgsConcreteOpts,
_genModuleTextArgsUTC = utc,
_genModuleTextArgsComments = _genSourceHtmlArgsComments,
_genModuleTextArgsModule = m
}
)
utc <- liftIO getCurrentTime
liftIO $
Text.writeFile
(toFilePath outputFile)
( run
. runReader htmlOptions
$ genModuleText
GenModuleTextArgs
{ _genModuleTextArgsConcreteOpts = o ^. genSourceHtmlArgsConcreteOpts,
_genModuleTextArgsUTC = utc,
_genModuleTextArgsComments = _genSourceHtmlArgsComments,
_genModuleTextArgsModule = m
}
)
where
ext = Text.unpack (htmlOptions ^. htmlOptionsExt)

Original file line number Diff line number Diff line change
@@ -39,9 +39,6 @@ data ProcessingState = ProcessingState
makeLenses ''ProcessJuvixBlocksArgs
makeLenses ''ProcessingState

fromJuvixMarkdown' :: ProcessJuvixBlocksArgs -> Either MarkdownBackendError Text
fromJuvixMarkdown' = run . runError . fromJuvixMarkdown

fromJuvixMarkdown ::
(Members '[Error MarkdownBackendError] r) =>
ProcessJuvixBlocksArgs ->
Loading