mirror of
https://github.com/anoma/juvix.git
synced 2024-08-16 11:40:36 +03:00
Add support for Literate Juvix Markdown (#2448)
This PR adds an initial support for Literate Juvix Markdown files, files with the extension `.juvix.md`. Here is a small example of such a file: `Test.juvix.md`. <pre> # This is a heading Lorem ... ```juvix module Test; type A := a; fun : A -> A | _ := a; ``` Other text </pre> This initial support enables users to execute common commands such as typechecking, compilation, and HTML generation. Additionally, a new command called `markdown` has been introduced. This command replaces code blocks marked with the juvix attribute with their respective HTML output, much like the output we obtain when running `juvix html`. In this version, comments are ignored in the output, including judoc blocks. - We intend to use this new feature in combination with this Python plugin (https://github.com/anoma/juvix-mkdocs) to enhance our documentation site. https://github.com/anoma/juvix/assets/1428088/a0c17f36-3d76-42cc-a571-91f885866874 ## Future work Open as issues once this PR is merged, we can work on the following: - Support imports of Juvix Markdown modules (update the path resolver to support imports of Literate Markdown files) - Support (Judoc) comments in md Juvix blocks - Support Markdown in Judoc blocks - Update Text editor support, vscode extension and emacs mode (the highlighting info is a few characters off in the current state) - Closes #1839 - Closes #1719
This commit is contained in:
Jonathan Cubides
GitHub
parent
31f519be4e
commit
bd16d3ef2a
1
.gitignore
vendored
1
.gitignore
vendored
@ -90,3 +90,4 @@ hie.yaml
|
||||
/.shake/
|
||||
/.benchmark-results/
|
||||
docs/assets/**
|
||||
.repos
|
||||
|
||||
@ -15,4 +15,4 @@ parseMainCompileOptions :: Parser CompileOptions
|
||||
parseMainCompileOptions =
|
||||
parseCompileOptions
|
||||
supportedTargets
|
||||
(parseInputFile FileExtJuvix)
|
||||
(parseInputFiles (NonEmpty.fromList [FileExtJuvix, FileExtJuvixMarkdown]))
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
module Commands.Eval.Options where
|
||||
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
import Evaluator qualified as Eval
|
||||
import Juvix.Compiler.Core.Pretty.Options qualified as Core
|
||||
|
||||
@ -29,7 +30,7 @@ instance CanonicalProjection EvalOptions Eval.EvalOptions where
|
||||
|
||||
parseEvalOptions :: Parser EvalOptions
|
||||
parseEvalOptions = do
|
||||
_evalInputFile <- parseInputFile FileExtJuvix
|
||||
_evalInputFile <- parseInputFiles (NonEmpty.fromList [FileExtJuvix, FileExtJuvixMarkdown])
|
||||
_evalSymbolName <-
|
||||
optional $
|
||||
strOption
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
module Commands.Html.Options where
|
||||
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
import Juvix.Compiler.Backend.Html.Data.Options hiding (HtmlOptions)
|
||||
|
||||
data HtmlOptions = HtmlOptions
|
||||
@ -91,7 +92,7 @@ parseHtml = do
|
||||
( long "open"
|
||||
<> help "Open the documentation after generating it"
|
||||
)
|
||||
_htmlInputFile <- parseInputFile FileExtJuvix
|
||||
_htmlInputFile <- parseInputFiles (NonEmpty.fromList [FileExtJuvix, FileExtJuvixMarkdown])
|
||||
pure HtmlOptions {..}
|
||||
where
|
||||
allThemes :: [Theme]
|
||||
|
||||
54
app/Commands/Markdown.hs
Normal file
54
app/Commands/Markdown.hs
Normal file
@ -0,0 +1,54 @@
|
||||
module Commands.Markdown where
|
||||
|
||||
import Commands.Base
|
||||
import Commands.Markdown.Options
|
||||
import Data.Text.IO qualified as Text
|
||||
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.Translation.FromParsed.Analysis.Scoping qualified as Scoper
|
||||
import Juvix.Extra.Assets (writeAssets)
|
||||
|
||||
runCommand ::
|
||||
(Members '[Embed IO, App] r) =>
|
||||
MarkdownOptions ->
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. markdownInputFile
|
||||
scopedM <- runPipeline inputFile upToScoping
|
||||
let m = head (scopedM ^. Scoper.resultModules)
|
||||
outputDir <- fromAppPathDir (opts ^. markdownOutputDir)
|
||||
md :: Text <-
|
||||
MK.fromJuvixMarkdown
|
||||
ProcessJuvixBlocksArgs
|
||||
{ _processJuvixBlocksArgsConcreteOpts = Concrete.defaultOptions,
|
||||
_processJuvixBlocksArgsUrlPrefix = opts ^. markdownUrlPrefix,
|
||||
_processJuvixBlocksArgsIdPrefix =
|
||||
opts ^. markdownIdPrefix,
|
||||
_processJuvixBlocksArgsNoPath =
|
||||
opts ^. markdownNoPath,
|
||||
_processJuvixBlocksArgsComments = scopedM ^. Scoper.comments,
|
||||
_processJuvixBlocksArgsModule = m,
|
||||
_processJuvixBlocksArgsOutputDir = outputDir
|
||||
}
|
||||
if
|
||||
| opts ^. markdownStdout -> liftIO . putStrLn $ md
|
||||
| otherwise -> do
|
||||
ensureDir outputDir
|
||||
when (opts ^. markdownWriteAssets) $
|
||||
liftIO $
|
||||
writeAssets outputDir
|
||||
|
||||
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
|
||||
56
app/Commands/Markdown/Options.hs
Normal file
56
app/Commands/Markdown/Options.hs
Normal file
@ -0,0 +1,56 @@
|
||||
module Commands.Markdown.Options where
|
||||
|
||||
import CommonOptions
|
||||
|
||||
data MarkdownOptions = MarkdownOptions
|
||||
{ _markdownInputFile :: AppPath File,
|
||||
_markdownOutputDir :: AppPath Dir,
|
||||
_markdownUrlPrefix :: Text,
|
||||
_markdownIdPrefix :: Text,
|
||||
_markdownNoPath :: Bool,
|
||||
_markdownStdout :: Bool,
|
||||
_markdownWriteAssets :: Bool
|
||||
}
|
||||
deriving stock (Data)
|
||||
|
||||
makeLenses ''MarkdownOptions
|
||||
|
||||
parseJuvixMarkdown :: Parser MarkdownOptions
|
||||
parseJuvixMarkdown = do
|
||||
_markdownUrlPrefix :: Text <-
|
||||
strOption
|
||||
( value mempty
|
||||
<> long "prefix-url"
|
||||
<> help "Prefix used for inner Juvix hyperlinks"
|
||||
)
|
||||
_markdownIdPrefix :: Text <-
|
||||
strOption
|
||||
( value mempty
|
||||
<> long "prefix-id"
|
||||
<> showDefault
|
||||
<> help "Prefix used for HTML element IDs"
|
||||
)
|
||||
_markdownInputFile <- parseInputFile FileExtJuvixMarkdown
|
||||
_markdownOutputDir <-
|
||||
parseGenericOutputDir
|
||||
( value "markdown"
|
||||
<> showDefault
|
||||
<> help "Markdown output directory"
|
||||
<> action "directory"
|
||||
)
|
||||
_markdownNoPath <-
|
||||
switch
|
||||
( long "no-path"
|
||||
<> help "Do not include the path to the input file in the HTML id hyperlinks"
|
||||
)
|
||||
_markdownWriteAssets <-
|
||||
switch
|
||||
( long "write-assets"
|
||||
<> help "Write the CSS/JS assets to the output directory"
|
||||
)
|
||||
_markdownStdout <-
|
||||
switch
|
||||
( long "stdout"
|
||||
<> help "Write the output to stdout instead of a file"
|
||||
)
|
||||
pure MarkdownOptions {..}
|
||||
@ -2,6 +2,7 @@ module Commands.Typecheck.Options where
|
||||
|
||||
import Commands.Dev.Internal.Typecheck.Options qualified as Internal
|
||||
import CommonOptions
|
||||
import Data.List.NonEmpty qualified as NonEmpty
|
||||
|
||||
newtype TypecheckOptions = TypecheckOptions
|
||||
{ _typecheckInputFile :: AppPath File
|
||||
@ -12,7 +13,7 @@ makeLenses ''TypecheckOptions
|
||||
|
||||
parseTypecheck :: Parser TypecheckOptions
|
||||
parseTypecheck = do
|
||||
_typecheckInputFile <- parseInputFile FileExtJuvix
|
||||
_typecheckInputFile <- parseInputFiles (NonEmpty.fromList [FileExtJuvix, FileExtJuvixMarkdown])
|
||||
pure TypecheckOptions {..}
|
||||
|
||||
instance CanonicalProjection TypecheckOptions Internal.InternalTypeOptions where
|
||||
|
||||
@ -10,6 +10,7 @@ import Commands.Eval qualified as Eval
|
||||
import Commands.Format qualified as Format
|
||||
import Commands.Html qualified as Html
|
||||
import Commands.Init qualified as Init
|
||||
import Commands.Markdown qualified as Markdown
|
||||
import Commands.Repl qualified as Repl
|
||||
import Commands.Typecheck qualified as Typecheck
|
||||
import Juvix.Extra.Version
|
||||
@ -37,6 +38,7 @@ runTopCommand = \case
|
||||
Clean opts -> runFilesIO (Clean.runCommand opts)
|
||||
Eval opts -> Eval.runCommand opts
|
||||
Html opts -> Html.runCommand opts
|
||||
Markdown opts -> Markdown.runCommand opts
|
||||
JuvixRepl opts -> Repl.runCommand opts
|
||||
JuvixFormat opts -> runFilesIO (Format.runCommand opts)
|
||||
Dependencies opts -> Dependencies.runCommand opts
|
||||
|
||||
@ -9,6 +9,7 @@ import Commands.Eval.Options
|
||||
import Commands.Format.Options
|
||||
import Commands.Html.Options
|
||||
import Commands.Init.Options
|
||||
import Commands.Markdown.Options
|
||||
import Commands.Repl.Options
|
||||
import Commands.Typecheck.Options
|
||||
import CommonOptions hiding (Doc)
|
||||
@ -25,6 +26,7 @@ data TopCommand
|
||||
| Clean CleanOptions
|
||||
| Eval EvalOptions
|
||||
| Html HtmlOptions
|
||||
| Markdown MarkdownOptions
|
||||
| Dev Dev.DevCommand
|
||||
| Doctor DoctorOptions
|
||||
| Init InitOptions
|
||||
@ -188,6 +190,13 @@ commandHtml =
|
||||
(Html <$> parseHtml)
|
||||
(progDesc "Generate HTML for a Juvix file")
|
||||
|
||||
commandMarkdown :: Mod CommandFields TopCommand
|
||||
commandMarkdown =
|
||||
command "markdown" $
|
||||
info
|
||||
(Markdown <$> parseJuvixMarkdown)
|
||||
(progDesc "Translate Juvix code blocks in a Markdown file to Markdown")
|
||||
|
||||
commandDev :: Mod CommandFields TopCommand
|
||||
commandDev =
|
||||
command "dev" $
|
||||
@ -204,7 +213,8 @@ parseCompilerCommand =
|
||||
commandCheck,
|
||||
commandCompile,
|
||||
commandEval,
|
||||
commandHtml
|
||||
commandHtml,
|
||||
commandMarkdown
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
@ -60,6 +60,8 @@ dependencies:
|
||||
- language-c == 0.9.*
|
||||
- libyaml == 0.1.*
|
||||
- megaparsec == 9.3.*
|
||||
- commonmark == 0.2.*
|
||||
- parsec == 3.1.*
|
||||
- microlens-platform == 0.4.*
|
||||
- parser-combinators == 1.3.*
|
||||
- path == 0.9.*
|
||||
|
||||
@ -16,6 +16,21 @@ data HtmlOptions = HtmlOptions
|
||||
_htmlOptionsNoFooter :: Bool
|
||||
}
|
||||
|
||||
defaultHtmlOptions :: HtmlOptions
|
||||
defaultHtmlOptions =
|
||||
HtmlOptions
|
||||
{ _htmlOptionsKind = HtmlDoc,
|
||||
_htmlOptionsAssetsPrefix = "",
|
||||
_htmlOptionsUrlPrefix = "",
|
||||
_htmlOptionsIdPrefix = "",
|
||||
_htmlOptionsOnlyCode = False,
|
||||
_htmlOptionsNoPath = False,
|
||||
_htmlOptionsOutputDir = $(mkAbsDir "/tmp"),
|
||||
_htmlOptionsParamBase = "",
|
||||
_htmlOptionsTheme = Nord,
|
||||
_htmlOptionsNoFooter = False
|
||||
}
|
||||
|
||||
data Theme
|
||||
= Nord
|
||||
| Ayu
|
||||
|
||||
@ -292,6 +292,18 @@ juColor = Attr.class_ . toStr
|
||||
JuVar -> "ju-var"
|
||||
JuNumber -> "ju-number"
|
||||
|
||||
juKindColor :: S.NameKind -> CssColor
|
||||
juKindColor = \case
|
||||
S.KNameConstructor -> JuConstructor
|
||||
S.KNameInductive -> JuInductive
|
||||
S.KNameFunction -> JuFunction
|
||||
S.KNameLocal -> JuVar
|
||||
S.KNameAxiom -> JuAxiom
|
||||
S.KNameLocalModule -> JuVar
|
||||
S.KNameAlias -> JuVar
|
||||
S.KNameTopModule -> JuVar
|
||||
S.KNameFixity -> JuFixity
|
||||
|
||||
putTag :: forall r. (Members '[Reader HtmlOptions] r) => Ann -> Html -> Sem r Html
|
||||
putTag ann x = case ann of
|
||||
AnnKind k -> return (tagKind k x)
|
||||
@ -330,18 +342,7 @@ putTag ann x = case ann of
|
||||
|
||||
tagKind k =
|
||||
Html.span
|
||||
! juColor
|
||||
( case k of
|
||||
S.KNameConstructor -> JuConstructor
|
||||
S.KNameInductive -> JuInductive
|
||||
S.KNameFunction -> JuFunction
|
||||
S.KNameLocal -> JuVar
|
||||
S.KNameAxiom -> JuAxiom
|
||||
S.KNameLocalModule -> JuVar
|
||||
S.KNameAlias -> JuVar
|
||||
S.KNameTopModule -> JuVar
|
||||
S.KNameFixity -> JuFixity
|
||||
)
|
||||
! juColor (juKindColor k)
|
||||
|
||||
nameIdAttr :: (Members '[Reader HtmlOptions] r) => S.NameId -> Sem r AttributeValue
|
||||
nameIdAttr (S.NameId k) = do
|
||||
|
||||
241
src/Juvix/Compiler/Backend/Markdown/Data/Types.hs
Normal file
241
src/Juvix/Compiler/Backend/Markdown/Data/Types.hs
Normal file
@ -0,0 +1,241 @@
|
||||
module Juvix.Compiler.Backend.Markdown.Data.Types where
|
||||
|
||||
import Commonmark qualified as MK
|
||||
import Data.Text qualified as T
|
||||
import Juvix.Data.Loc
|
||||
import Juvix.Prelude hiding (Raw)
|
||||
import Juvix.Prelude.Pretty
|
||||
import Text.Show qualified as Show
|
||||
|
||||
newtype MkJuvixBlockOptions = MkJuvixBlockOptions
|
||||
{ _mkJuvixBlockOptionsHide :: Bool
|
||||
}
|
||||
deriving stock (Eq, Ord)
|
||||
|
||||
data JuvixCodeBlock = JuvixCodeBlock
|
||||
{ _juvixCodeBlock :: Text,
|
||||
_juvixCodeBlockOptions :: MkJuvixBlockOptions,
|
||||
_juvixCodeBlockInterval :: Maybe Interval
|
||||
}
|
||||
deriving stock (Eq, Ord)
|
||||
|
||||
data TextBlock = TextBlock
|
||||
{ _textBlock :: !Text,
|
||||
_textBlockInterval :: Maybe Interval
|
||||
}
|
||||
deriving stock (Eq, Ord)
|
||||
|
||||
makeLenses ''JuvixCodeBlock
|
||||
makeLenses ''MkJuvixBlockOptions
|
||||
makeLenses ''TextBlock
|
||||
|
||||
defaultMkJuvixBlockOptions :: MkJuvixBlockOptions
|
||||
defaultMkJuvixBlockOptions =
|
||||
MkJuvixBlockOptions
|
||||
{ _mkJuvixBlockOptionsHide = False
|
||||
}
|
||||
|
||||
instance Show TextBlock where
|
||||
show t = T.unpack (t ^. textBlock)
|
||||
|
||||
textJuvixBlockOptions :: MkJuvixBlockOptions -> Text
|
||||
textJuvixBlockOptions opt =
|
||||
T.intercalate " " $
|
||||
catMaybes
|
||||
[ if opt ^. mkJuvixBlockOptionsHide then Just "hide" else Nothing
|
||||
]
|
||||
|
||||
instance Show MkJuvixBlockOptions where
|
||||
show opt = T.unpack (textJuvixBlockOptions opt)
|
||||
|
||||
textJuvixCodeBlock :: JuvixCodeBlock -> Text
|
||||
textJuvixCodeBlock cb =
|
||||
mconcat
|
||||
[ "```juvix",
|
||||
textJuvixBlockOptions (cb ^. juvixCodeBlockOptions),
|
||||
nl,
|
||||
cb ^. juvixCodeBlock,
|
||||
"```"
|
||||
]
|
||||
|
||||
instance Show JuvixCodeBlock where
|
||||
show cb = T.unpack (textJuvixCodeBlock cb)
|
||||
|
||||
data Mk
|
||||
= MkJuvixCodeBlock JuvixCodeBlock
|
||||
| MkTextBlock TextBlock
|
||||
| MkNull
|
||||
| MkConcat Mk Mk
|
||||
deriving stock (Eq, Show, Ord)
|
||||
|
||||
instance Semigroup TextBlock where
|
||||
a <> b =
|
||||
TextBlock
|
||||
{ _textBlock = a ^. textBlock <> b ^. textBlock,
|
||||
_textBlockInterval = a ^. textBlockInterval <> b ^. textBlockInterval
|
||||
}
|
||||
|
||||
instance Monoid TextBlock where
|
||||
mempty =
|
||||
TextBlock
|
||||
{ _textBlock = mempty,
|
||||
_textBlockInterval = Nothing
|
||||
}
|
||||
mappend = (<>)
|
||||
|
||||
instance Semigroup MkJuvixBlockOptions where
|
||||
a <> b =
|
||||
MkJuvixBlockOptions
|
||||
{ _mkJuvixBlockOptionsHide = a ^. mkJuvixBlockOptionsHide || b ^. mkJuvixBlockOptionsHide
|
||||
}
|
||||
|
||||
instance Monoid MkJuvixBlockOptions where
|
||||
mempty =
|
||||
MkJuvixBlockOptions
|
||||
{ _mkJuvixBlockOptionsHide = False
|
||||
}
|
||||
mappend = (<>)
|
||||
|
||||
instance Semigroup Mk where
|
||||
a <> MkNull = a
|
||||
MkNull <> a = a
|
||||
a <> b = MkConcat a b
|
||||
|
||||
instance Monoid Mk where
|
||||
mempty = MkNull
|
||||
mappend = (<>)
|
||||
|
||||
nl :: Text
|
||||
nl = "\n"
|
||||
|
||||
instance MK.ToPlainText TextBlock where
|
||||
toPlainText r = r ^. textBlock
|
||||
|
||||
instance MK.ToPlainText JuvixCodeBlock where
|
||||
toPlainText = show
|
||||
|
||||
instance MK.ToPlainText Mk where
|
||||
toPlainText =
|
||||
trimText
|
||||
. mconcat
|
||||
. builder
|
||||
|
||||
builder :: Mk -> [Text]
|
||||
builder = \case
|
||||
MkConcat a b -> builder a <> builder b
|
||||
MkTextBlock t -> [trimText (t ^. textBlock) <> nl]
|
||||
MkJuvixCodeBlock j -> [textJuvixCodeBlock j]
|
||||
MkNull -> mempty
|
||||
|
||||
flatten :: [Mk] -> Mk
|
||||
flatten = foldl' (<>) MkNull
|
||||
|
||||
instance MK.Rangeable Mk where
|
||||
ranged _ x = x
|
||||
|
||||
toTextBlock :: Text -> TextBlock
|
||||
toTextBlock t =
|
||||
TextBlock
|
||||
{ _textBlock = t,
|
||||
_textBlockInterval = mempty
|
||||
}
|
||||
|
||||
toMK :: Text -> Mk
|
||||
toMK = MkTextBlock . toTextBlock
|
||||
|
||||
toMK' :: Text -> Interval -> Mk
|
||||
toMK' t i =
|
||||
MkTextBlock
|
||||
TextBlock
|
||||
{ _textBlock = t,
|
||||
_textBlockInterval = Just i
|
||||
}
|
||||
|
||||
wrap' :: Text -> Text -> TextBlock -> TextBlock
|
||||
wrap' t1 t2 a = toTextBlock t1 <> a <> toTextBlock t2
|
||||
|
||||
wrap :: Text -> TextBlock -> TextBlock
|
||||
wrap t = wrap' t t
|
||||
|
||||
paren :: TextBlock -> TextBlock
|
||||
paren = wrap' "(" ")"
|
||||
|
||||
brack :: TextBlock -> TextBlock
|
||||
brack = wrap' "[" "]"
|
||||
|
||||
instance MK.HasAttributes TextBlock where
|
||||
addAttributes _ = id
|
||||
|
||||
instance MK.Rangeable TextBlock where
|
||||
ranged _ r = r
|
||||
|
||||
instance MK.HasAttributes Mk where
|
||||
addAttributes _ = id
|
||||
|
||||
instance MK.IsInline TextBlock where
|
||||
lineBreak = toTextBlock nl
|
||||
softBreak = toTextBlock " "
|
||||
str = toTextBlock
|
||||
entity = toTextBlock
|
||||
escapedChar = toTextBlock . T.singleton
|
||||
emph = wrap "*"
|
||||
strong = wrap "**"
|
||||
link dest _ desc =
|
||||
brack desc <> paren (toTextBlock dest)
|
||||
image src _ desc =
|
||||
toTextBlock "!" <> brack desc <> paren (toTextBlock src)
|
||||
code = wrap "`" . toTextBlock
|
||||
rawInline f t
|
||||
| f == MK.Format "html" =
|
||||
toTextBlock t
|
||||
| otherwise = mempty
|
||||
|
||||
getJuvixBlockOptions :: Text -> MkJuvixBlockOptions
|
||||
getJuvixBlockOptions = \case
|
||||
"hide" -> mempty {_mkJuvixBlockOptionsHide = True}
|
||||
_ -> mempty
|
||||
|
||||
nl' :: Mk
|
||||
nl' = toMK nl
|
||||
|
||||
processCodeBlock :: Text -> Text -> Maybe Interval -> Mk
|
||||
processCodeBlock info t loc =
|
||||
case T.splitOn " " (T.strip info) of
|
||||
("juvix" : opts) ->
|
||||
MkJuvixCodeBlock
|
||||
JuvixCodeBlock
|
||||
{ _juvixCodeBlock = t,
|
||||
_juvixCodeBlockOptions = foldMap getJuvixBlockOptions opts,
|
||||
_juvixCodeBlockInterval = loc
|
||||
}
|
||||
_ ->
|
||||
let b = "```" <> info <> nl <> t <> "```"
|
||||
in MkTextBlock TextBlock {_textBlock = b, _textBlockInterval = loc}
|
||||
|
||||
instance-- (MK.IsInline TextBlock) =>
|
||||
MK.IsBlock TextBlock Mk where
|
||||
paragraph a = MkTextBlock a
|
||||
plain a = MkTextBlock a
|
||||
thematicBreak = toMK "---"
|
||||
blockQuote p = toMK "> " <> p
|
||||
heading n t = toMK $ (T.replicate n "#") <> " " <> t ^. textBlock
|
||||
rawBlock _ t = toMK t
|
||||
codeBlock i t = processCodeBlock i t mempty
|
||||
referenceLinkDefinition _ _ = mempty
|
||||
list _ _ xs =
|
||||
mconcat
|
||||
( map
|
||||
( \b -> case b of
|
||||
MkTextBlock tb ->
|
||||
MkTextBlock
|
||||
(tb {_textBlock = "- " <> tb ^. textBlock})
|
||||
_ -> b
|
||||
)
|
||||
xs
|
||||
)
|
||||
|
||||
extractJuvixCodeBlock :: Mk -> [JuvixCodeBlock]
|
||||
extractJuvixCodeBlock = \case
|
||||
MkJuvixCodeBlock j -> [j]
|
||||
MkConcat a b -> extractJuvixCodeBlock a <> extractJuvixCodeBlock b
|
||||
_ -> []
|
||||
@ -0,0 +1,164 @@
|
||||
module Juvix.Compiler.Backend.Markdown.Translation.FromTyped.Source where
|
||||
|
||||
import Commonmark qualified as MK
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.Lazy (toStrict)
|
||||
import Juvix.Compiler.Backend.Html.Data.Options qualified as HtmlRender
|
||||
import Juvix.Compiler.Backend.Html.Translation.FromTyped.Source qualified as HtmlRender
|
||||
import Juvix.Compiler.Backend.Markdown.Data.Types
|
||||
import Juvix.Compiler.Concrete.Language qualified as Concrete
|
||||
import Juvix.Compiler.Concrete.Pretty qualified as Concrete
|
||||
import Juvix.Prelude
|
||||
import Text.Blaze.Html
|
||||
import Text.Blaze.Html.Renderer.Text qualified as Html
|
||||
import Text.Blaze.Html5 as Html hiding (map)
|
||||
import Text.Blaze.Html5.Attributes qualified as Attr
|
||||
|
||||
data ProcessJuvixBlocksArgs = ProcessJuvixBlocksArgs
|
||||
{ _processJuvixBlocksArgsConcreteOpts :: Concrete.Options,
|
||||
_processJuvixBlocksArgsUrlPrefix :: Text,
|
||||
_processJuvixBlocksArgsIdPrefix :: Text,
|
||||
_processJuvixBlocksArgsNoPath :: Bool,
|
||||
_processJuvixBlocksArgsComments :: Comments,
|
||||
_processJuvixBlocksArgsOutputDir :: Path Abs Dir,
|
||||
_processJuvixBlocksArgsModule :: Concrete.Module 'Concrete.Scoped 'Concrete.ModuleTop
|
||||
}
|
||||
|
||||
data ProcessingState = ProcessingState
|
||||
{ _processingStateMk :: Mk,
|
||||
_processingStateFirstBlock :: Bool,
|
||||
_processingStateStmtsSeparation :: [Int],
|
||||
_processingStateStmts :: [Concrete.Statement 'Concrete.Scoped]
|
||||
}
|
||||
|
||||
makeLenses ''ProcessJuvixBlocksArgs
|
||||
makeLenses ''ProcessingState
|
||||
|
||||
fromJuvixMarkdown' :: ProcessJuvixBlocksArgs -> Text
|
||||
fromJuvixMarkdown' = run . fromJuvixMarkdown
|
||||
|
||||
fromJuvixMarkdown ::
|
||||
ProcessJuvixBlocksArgs ->
|
||||
Sem r Text
|
||||
fromJuvixMarkdown opts = do
|
||||
let htmlOptions :: HtmlRender.HtmlOptions
|
||||
htmlOptions =
|
||||
HtmlRender.defaultHtmlOptions
|
||||
{ HtmlRender._htmlOptionsKind = HtmlRender.HtmlOnly,
|
||||
HtmlRender._htmlOptionsAssetsPrefix = opts ^. processJuvixBlocksArgsUrlPrefix,
|
||||
HtmlRender._htmlOptionsUrlPrefix = opts ^. processJuvixBlocksArgsUrlPrefix,
|
||||
HtmlRender._htmlOptionsIdPrefix = opts ^. processJuvixBlocksArgsIdPrefix,
|
||||
HtmlRender._htmlOptionsNoPath = opts ^. processJuvixBlocksArgsNoPath,
|
||||
HtmlRender._htmlOptionsOutputDir = opts ^. processJuvixBlocksArgsOutputDir
|
||||
}
|
||||
|
||||
m :: Concrete.Module 'Concrete.Scoped 'Concrete.ModuleTop
|
||||
m = opts ^. processJuvixBlocksArgsModule
|
||||
|
||||
case (m ^. Concrete.moduleMarkdown, m ^. Concrete.moduleMarkdownSeparation) of
|
||||
(Just mk, Just sepr) -> do
|
||||
let st =
|
||||
ProcessingState
|
||||
{ _processingStateMk = mk,
|
||||
_processingStateFirstBlock = True,
|
||||
_processingStateStmtsSeparation = sepr,
|
||||
_processingStateStmts = indModuleFilter $ m ^. Concrete.moduleBody
|
||||
}
|
||||
(_, r) <- runState st . runReader htmlOptions . runReader opts $ go
|
||||
return $ MK.toPlainText r
|
||||
(Nothing, _) -> error "This module has no Markdown"
|
||||
(_, _) -> error "This Markdown file has no Juvix code blocks"
|
||||
|
||||
htmlSemicolon :: Html
|
||||
htmlSemicolon = Html.span ! HtmlRender.juColor HtmlRender.JuDelimiter $ ";"
|
||||
|
||||
go ::
|
||||
forall r.
|
||||
( Members
|
||||
'[ Reader HtmlRender.HtmlOptions,
|
||||
Reader ProcessJuvixBlocksArgs,
|
||||
State ProcessingState
|
||||
]
|
||||
r
|
||||
) =>
|
||||
Sem r Mk
|
||||
go = do
|
||||
stmts <- gets @ProcessingState (^. processingStateStmts)
|
||||
sepr <- gets @ProcessingState (^. processingStateStmtsSeparation)
|
||||
mk <- gets @ProcessingState (^. processingStateMk)
|
||||
case (sepr, stmts) of
|
||||
([], _) -> return mk
|
||||
((n : ns), _) -> do
|
||||
case mk of
|
||||
MkNull -> return mk
|
||||
MkTextBlock _ -> return mk
|
||||
MkConcat l r -> do
|
||||
modify (set processingStateMk l)
|
||||
lS <- go
|
||||
modify (set processingStateMk r)
|
||||
MkConcat lS <$> go
|
||||
MkJuvixCodeBlock j -> do
|
||||
m <-
|
||||
asks @ProcessJuvixBlocksArgs
|
||||
(^. processJuvixBlocksArgsModule)
|
||||
|
||||
isFirstBlock <- gets @ProcessingState (^. processingStateFirstBlock)
|
||||
|
||||
let stmts' = take n stmts
|
||||
|
||||
htmlStatements :: [Html] <-
|
||||
mapM (\s -> goRender s <> pure htmlSemicolon) stmts'
|
||||
|
||||
resHtml <-
|
||||
toStrict
|
||||
. Html.renderHtml
|
||||
. (pre ! Attr.class_ "highlight")
|
||||
. (code ! Attr.class_ "juvix")
|
||||
. (pre ! Attr.class_ "src-content")
|
||||
<$> do
|
||||
if isFirstBlock
|
||||
then do
|
||||
let m' = set Concrete.moduleBody stmts' m
|
||||
goRender m'
|
||||
else
|
||||
return $
|
||||
Html.preEscapedText $
|
||||
Text.intercalate "\n\n" $
|
||||
map (toStrict . Html.renderHtml) htmlStatements
|
||||
let _processingStateMk =
|
||||
if j ^. juvixCodeBlockOptions . mkJuvixBlockOptionsHide
|
||||
then MkNull
|
||||
else
|
||||
MkTextBlock
|
||||
TextBlock
|
||||
{ _textBlock = resHtml,
|
||||
_textBlockInterval = j ^. juvixCodeBlockInterval
|
||||
}
|
||||
let newState =
|
||||
ProcessingState
|
||||
{ _processingStateFirstBlock = False,
|
||||
_processingStateStmtsSeparation = ns,
|
||||
_processingStateStmts = drop n stmts,
|
||||
..
|
||||
}
|
||||
modify @ProcessingState $ \_ -> newState
|
||||
return _processingStateMk
|
||||
|
||||
goRender :: (Concrete.PrettyPrint a, Members '[Reader HtmlRender.HtmlOptions, Reader ProcessJuvixBlocksArgs] r) => a -> Sem r Html
|
||||
goRender xs = do
|
||||
concreteOpts <- asks @ProcessJuvixBlocksArgs (^. processJuvixBlocksArgsConcreteOpts)
|
||||
HtmlRender.ppCodeHtml concreteOpts xs
|
||||
|
||||
indModuleFilter :: [Concrete.Statement s] -> [Concrete.Statement s]
|
||||
indModuleFilter =
|
||||
filter
|
||||
( \case
|
||||
Concrete.StatementSyntax _ -> True
|
||||
Concrete.StatementFunctionDef _ -> True
|
||||
Concrete.StatementImport _ -> True
|
||||
Concrete.StatementInductive _ -> True
|
||||
Concrete.StatementModule o -> not (o ^. Concrete.moduleInductive)
|
||||
Concrete.StatementOpenModule _ -> True
|
||||
Concrete.StatementAxiom _ -> True
|
||||
Concrete.StatementProjectionDef _ -> True
|
||||
)
|
||||
@ -19,6 +19,7 @@ module Juvix.Compiler.Concrete.Language
|
||||
where
|
||||
|
||||
import Data.Kind qualified as GHC
|
||||
import Juvix.Compiler.Backend.Markdown.Data.Types (Mk)
|
||||
import Juvix.Compiler.Concrete.Data.Builtins
|
||||
import Juvix.Compiler.Concrete.Data.Literal
|
||||
import Juvix.Compiler.Concrete.Data.ModuleIsTop
|
||||
@ -927,7 +928,9 @@ data Module (s :: Stage) (t :: ModuleIsTop) = Module
|
||||
_modulePragmas :: Maybe ParsedPragmas,
|
||||
_moduleBody :: [Statement s],
|
||||
_moduleKwEnd :: ModuleEndType t,
|
||||
_moduleInductive :: ModuleInductiveType t
|
||||
_moduleInductive :: ModuleInductiveType t,
|
||||
_moduleMarkdown :: Maybe Mk,
|
||||
_moduleMarkdownSeparation :: Maybe [Int]
|
||||
}
|
||||
|
||||
deriving stock instance Show (Module 'Parsed 'ModuleTop)
|
||||
|
||||
@ -1071,7 +1071,8 @@ checkTopModule m@Module {..} = do
|
||||
_modulePragmas = _modulePragmas,
|
||||
_moduleKw,
|
||||
_moduleInductive,
|
||||
_moduleKwEnd
|
||||
_moduleKwEnd,
|
||||
..
|
||||
}
|
||||
_moduleRefName = S.unConcrete path'
|
||||
return (ModuleRef'' {..}, path')
|
||||
@ -1304,6 +1305,8 @@ checkSections sec = do
|
||||
{ _moduleDoc = Nothing,
|
||||
_modulePragmas = Nothing,
|
||||
_moduleInductive = True,
|
||||
_moduleMarkdown = Nothing,
|
||||
_moduleMarkdownSeparation = Nothing,
|
||||
..
|
||||
}
|
||||
where
|
||||
@ -1434,6 +1437,8 @@ checkLocalModule Module {..} = do
|
||||
_moduleBody = moduleBody',
|
||||
_moduleDoc = moduleDoc',
|
||||
_modulePragmas = _modulePragmas,
|
||||
_moduleMarkdown = Nothing,
|
||||
_moduleMarkdownSeparation = Nothing,
|
||||
_moduleKw,
|
||||
_moduleInductive,
|
||||
_moduleKwEnd
|
||||
|
||||
@ -6,11 +6,14 @@ module Juvix.Compiler.Concrete.Translation.FromSource
|
||||
)
|
||||
where
|
||||
|
||||
import Commonmark qualified as MK
|
||||
import Control.Applicative.Permutations
|
||||
import Data.ByteString.UTF8 qualified as BS
|
||||
import Data.List.NonEmpty.Extra qualified as NonEmpty
|
||||
import Data.Singletons
|
||||
import Data.Text qualified as Text
|
||||
import Juvix.Compiler.Backend.Markdown.Data.Types (Mk (..))
|
||||
import Juvix.Compiler.Backend.Markdown.Data.Types qualified as MK
|
||||
import Juvix.Compiler.Concrete.Data.Highlight.Input (HighlightBuilder, ignoreHighlightBuilder)
|
||||
import Juvix.Compiler.Concrete.Data.ParsedInfoTable
|
||||
import Juvix.Compiler.Concrete.Data.ParsedInfoTableBuilder
|
||||
@ -119,15 +122,100 @@ runReplInputParser fileName input = do
|
||||
Left err -> throw (ErrMegaparsec (MegaparsecError err))
|
||||
Right r -> return r
|
||||
|
||||
runModuleParser :: (Members '[Error ParserError, Files, PathResolver, NameIdGen, InfoTableBuilder] r) => Path Abs File -> Text -> Sem r (Either ParserError (Module 'Parsed 'ModuleTop))
|
||||
runModuleParser fileName input = do
|
||||
m <-
|
||||
evalState (Nothing @ParsedPragmas)
|
||||
. evalState (Nothing @(Judoc 'Parsed))
|
||||
$ P.runParserT topModuleDef (toFilePath fileName) input
|
||||
case m of
|
||||
Left err -> return (Left (ErrMegaparsec (MegaparsecError err)))
|
||||
Right r -> registerModule r $> Right r
|
||||
runModuleParser ::
|
||||
(Members '[Error ParserError, Files, PathResolver, NameIdGen, InfoTableBuilder] r) =>
|
||||
Path Abs File ->
|
||||
Text ->
|
||||
Sem r (Either ParserError (Module 'Parsed 'ModuleTop))
|
||||
runModuleParser fileName input
|
||||
| isJuvixMarkdownFile fileName = do
|
||||
res <- P.runParserT juvixCodeBlockParser (toFilePath fileName) input
|
||||
case res of
|
||||
Left err -> return . Left . ErrMegaparsec . MegaparsecError $ err
|
||||
Right r -> runMarkdownModuleParser fileName r
|
||||
| otherwise = do
|
||||
m <-
|
||||
evalState (Nothing @ParsedPragmas)
|
||||
. evalState (Nothing @(Judoc 'Parsed))
|
||||
$ P.runParserT topModuleDef (toFilePath fileName) input
|
||||
case m of
|
||||
Left err -> return . Left . ErrMegaparsec . MegaparsecError $ err
|
||||
Right r -> registerModule r $> Right r
|
||||
|
||||
runMarkdownModuleParser ::
|
||||
(Members '[Error ParserError, Files, PathResolver, NameIdGen, InfoTableBuilder] r) =>
|
||||
Path Abs File ->
|
||||
Mk ->
|
||||
Sem r (Either ParserError (Module 'Parsed 'ModuleTop))
|
||||
runMarkdownModuleParser fileName mk = do
|
||||
res <- go Nothing (MK.extractJuvixCodeBlock mk) []
|
||||
case res of
|
||||
Left err -> return . Left $ err
|
||||
Right m' -> do
|
||||
let m = set moduleMarkdown (Just mk) m'
|
||||
registerModule m $> Right m
|
||||
where
|
||||
getInitPos :: Interval -> P.SourcePos
|
||||
getInitPos i =
|
||||
P.SourcePos
|
||||
{ P.sourceName = fromAbsFile $ i ^. intervalFile,
|
||||
P.sourceLine = P.mkPos (intervalStartLine i),
|
||||
P.sourceColumn = P.mkPos (intervalStartCol i)
|
||||
}
|
||||
|
||||
getInitialParserState :: forall a. MK.JuvixCodeBlock -> P.State Text a
|
||||
getInitialParserState code =
|
||||
let initPos =
|
||||
maybe
|
||||
(P.initialPos (toFilePath fileName))
|
||||
getInitPos
|
||||
(code ^. MK.juvixCodeBlockInterval)
|
||||
in P.State
|
||||
{ P.stateInput = code ^. MK.juvixCodeBlock,
|
||||
P.statePosState =
|
||||
P.PosState
|
||||
{ P.pstateInput = code ^. MK.juvixCodeBlock,
|
||||
P.pstateOffset = 0,
|
||||
P.pstateSourcePos = initPos,
|
||||
P.pstateTabWidth = P.defaultTabWidth,
|
||||
P.pstateLinePrefix = ""
|
||||
},
|
||||
P.stateOffset = 0,
|
||||
P.stateParseErrors = []
|
||||
}
|
||||
go ::
|
||||
forall r.
|
||||
(Members '[Error ParserError, Files, PathResolver, NameIdGen, InfoTableBuilder] r) =>
|
||||
Maybe (Module 'Parsed 'ModuleTop) ->
|
||||
[MK.JuvixCodeBlock] ->
|
||||
[Int] ->
|
||||
Sem r (Either ParserError (Module 'Parsed 'ModuleTop))
|
||||
go Nothing [] _ =
|
||||
error "There is no module declaration in the markdown file"
|
||||
go Nothing (x : xs) ls = do
|
||||
(_, res) <-
|
||||
evalState (Nothing @ParsedPragmas)
|
||||
. evalState (Nothing @(Judoc 'Parsed))
|
||||
$ P.runParserT' topMarkdownModuleDef (getInitialParserState x)
|
||||
case res of
|
||||
Left err ->
|
||||
return . Left . ErrMegaparsec . MegaparsecError $ err
|
||||
Right m -> do
|
||||
go (Just m) xs (length (m ^. moduleBody) : ls)
|
||||
go (Just m) [] ls =
|
||||
return
|
||||
. Right
|
||||
$ set moduleMarkdownSeparation (Just (reverse ls)) m
|
||||
go (Just m') (x : xs) n = do
|
||||
(_, res) <-
|
||||
evalState (Nothing @ParsedPragmas)
|
||||
. evalState (Nothing @(Judoc 'Parsed))
|
||||
$ P.runParserT' parseTopStatements (getInitialParserState x)
|
||||
case res of
|
||||
Left err -> return . Left . ErrMegaparsec . MegaparsecError $ err
|
||||
Right stmts -> do
|
||||
let m = set moduleBody (m' ^. moduleBody <> stmts) m'
|
||||
go (Just m) xs (length stmts : n)
|
||||
|
||||
runModuleStdinParser ::
|
||||
(Members '[Error ParserError, Files, PathResolver, NameIdGen, InfoTableBuilder] r) =>
|
||||
@ -178,6 +266,26 @@ topModuleDefStdin = do
|
||||
optional_ stashJudoc
|
||||
top moduleDef
|
||||
|
||||
-- FIX: https://github.com/anoma/juvix/pull/251
|
||||
checkPath ::
|
||||
(Members '[PathResolver, Error ParserError] s) =>
|
||||
Maybe (Path Abs File) ->
|
||||
TopModulePath ->
|
||||
Sem s ()
|
||||
checkPath maybePath path = do
|
||||
let actualPath = fromMaybe (getLoc path ^. intervalFile) maybePath
|
||||
mexpectedPath <- expectedModulePath actualPath path
|
||||
whenJust mexpectedPath $ \expectedPath ->
|
||||
unlessM (equalPaths expectedPath actualPath) $
|
||||
throw
|
||||
( ErrWrongTopModuleName
|
||||
WrongTopModuleName
|
||||
{ _wrongTopModuleNameActualName = path,
|
||||
_wrongTopModuleNameExpectedPath = expectedPath,
|
||||
_wrongTopModuleNameActualPath = actualPath
|
||||
}
|
||||
)
|
||||
|
||||
topModuleDef ::
|
||||
(Members '[Error ParserError, Files, PathResolver, InfoTableBuilder, PragmasStash, JudocStash, NameIdGen] r) =>
|
||||
ParsecS r (Module 'Parsed 'ModuleTop)
|
||||
@ -185,23 +293,77 @@ topModuleDef = do
|
||||
space >> optional_ stashJudoc
|
||||
optional_ stashPragmas
|
||||
m <- top moduleDef
|
||||
P.lift (checkPath (m ^. modulePath))
|
||||
P.lift (checkPath Nothing (m ^. modulePath))
|
||||
return m
|
||||
|
||||
juvixCodeBlockParser ::
|
||||
ParsecS r Mk
|
||||
juvixCodeBlockParser = do
|
||||
ls :: [Mk] <-
|
||||
many $
|
||||
goJuvixCodeBlock
|
||||
<|> MK.MkTextBlock <$> goTextBlock
|
||||
return $ foldl' (<>) MkNull ls
|
||||
where
|
||||
checkPath :: (Members '[PathResolver, Error ParserError] s) => TopModulePath -> Sem s ()
|
||||
checkPath path = do
|
||||
let actualPath :: Path Abs File = getLoc path ^. intervalFile
|
||||
mexpectedPath <- expectedModulePath actualPath path
|
||||
whenJust mexpectedPath $ \expectedPath ->
|
||||
unlessM (equalPaths expectedPath actualPath) $
|
||||
throw
|
||||
( ErrWrongTopModuleName
|
||||
WrongTopModuleName
|
||||
{ _wrongTopModuleNameActualName = path,
|
||||
_wrongTopModuleNameExpectedPath = expectedPath,
|
||||
_wrongTopModuleNameActualPath = actualPath
|
||||
}
|
||||
)
|
||||
mdCodeToken :: ParsecS r Text
|
||||
mdCodeToken = P.string "```"
|
||||
|
||||
goValidText :: ParsecS r (WithLoc Text)
|
||||
goValidText = do
|
||||
p <- withLoc $ P.manyTill P.anySingle (P.lookAhead mdCodeToken)
|
||||
return $
|
||||
WithLoc
|
||||
{ _withLocInt = getLoc p,
|
||||
_withLocParam = Text.pack $ p ^. withLocParam
|
||||
}
|
||||
|
||||
goTextBlock :: ParsecS r MK.TextBlock
|
||||
goTextBlock = do
|
||||
w <- goValidText
|
||||
return $
|
||||
MK.TextBlock
|
||||
{ _textBlock = w ^. withLocParam,
|
||||
_textBlockInterval = Just $ getLoc w
|
||||
}
|
||||
|
||||
goJuvixCodeBlock :: ParsecS r MK.Mk
|
||||
goJuvixCodeBlock = do
|
||||
void mdCodeToken
|
||||
info :: Text <- Text.pack <$> P.manyTill P.anySingle (P.lookAhead (P.string "\n"))
|
||||
t <- goValidText
|
||||
void mdCodeToken
|
||||
return $
|
||||
MK.processCodeBlock
|
||||
info
|
||||
(t ^. withLocParam)
|
||||
(Just $ t ^. withLocInt)
|
||||
|
||||
-- Keep it. Intended to be used later for processing Markdown inside TextBlocks
|
||||
-- or (Judoc) comments.
|
||||
commanMarkParser ::
|
||||
(Members '[Error ParserError, Files, NameIdGen, InfoTableBuilder, PathResolver] r) =>
|
||||
Path Abs File ->
|
||||
Text ->
|
||||
Sem r (Either ParserError (Module 'Parsed 'ModuleTop))
|
||||
commanMarkParser fileName input = do
|
||||
res <- MK.commonmarkWith MK.defaultSyntaxSpec (toFilePath fileName) input
|
||||
case res of
|
||||
Right (r :: Mk) -> runMarkdownModuleParser fileName r
|
||||
Left r -> return . Left . ErrCommonmark . CommonmarkError $ r
|
||||
|
||||
topMarkdownModuleDef ::
|
||||
(Members '[Error ParserError, Files, PathResolver, InfoTableBuilder, PragmasStash, JudocStash, NameIdGen] r) =>
|
||||
ParsecS r (Module 'Parsed 'ModuleTop)
|
||||
topMarkdownModuleDef = do
|
||||
optional_ stashJudoc
|
||||
optional_ stashPragmas
|
||||
top moduleDef
|
||||
|
||||
parseTopStatements ::
|
||||
forall r.
|
||||
(Members '[Error ParserError, Files, PathResolver, InfoTableBuilder, PragmasStash, JudocStash, NameIdGen] r) =>
|
||||
ParsecS r [Statement 'Parsed]
|
||||
parseTopStatements = top $ P.sepEndBy statement semicolon
|
||||
|
||||
replInput :: forall r. (Members '[Files, PathResolver, InfoTableBuilder, JudocStash, NameIdGen, Error ParserError, State (Maybe ParsedPragmas)] r) => ParsecS r ReplInput
|
||||
replInput =
|
||||
@ -291,6 +453,22 @@ l <?|> r = do
|
||||
r
|
||||
P.withRecovery (const recover) (P.try l)
|
||||
|
||||
initialState :: String -> s -> P.State s e
|
||||
initialState fpath s =
|
||||
P.State
|
||||
{ stateInput = s,
|
||||
stateOffset = 0,
|
||||
statePosState =
|
||||
P.PosState
|
||||
{ pstateInput = s,
|
||||
pstateOffset = 0,
|
||||
pstateSourcePos = P.initialPos fpath,
|
||||
pstateTabWidth = P.defaultTabWidth,
|
||||
pstateLinePrefix = ""
|
||||
},
|
||||
stateParseErrors = []
|
||||
}
|
||||
|
||||
statement :: (Members '[Files, Error ParserError, PathResolver, InfoTableBuilder, PragmasStash, JudocStash, NameIdGen] r) => ParsecS r (Statement 'Parsed)
|
||||
statement = P.label "<top level statement>" $ do
|
||||
optional_ stashJudoc
|
||||
@ -1436,7 +1614,12 @@ moduleDef = P.label "<module definition>" $ do
|
||||
semicolon
|
||||
_moduleBody <- P.sepEndBy statement semicolon
|
||||
_moduleKwEnd <- endModule
|
||||
return Module {..}
|
||||
return
|
||||
Module
|
||||
{ _moduleMarkdown = Nothing,
|
||||
_moduleMarkdownSeparation = Nothing,
|
||||
..
|
||||
}
|
||||
where
|
||||
_moduleInductive :: ModuleInductiveType t
|
||||
_moduleInductive = case sing :: SModuleIsTop t of
|
||||
|
||||
@ -184,6 +184,8 @@ toConcrete t p = run . runReader l $ do
|
||||
_moduleInductive = (),
|
||||
_moduleDoc = Nothing,
|
||||
_modulePragmas = Nothing,
|
||||
_moduleMarkdown = Nothing,
|
||||
_moduleMarkdownSeparation = Nothing,
|
||||
..
|
||||
}
|
||||
where
|
||||
|
||||
@ -111,7 +111,7 @@ isJuvixFile = (== Just juvixFileExt) . fileExtension
|
||||
|
||||
isJuvixMarkdownFile :: Path b File -> Bool
|
||||
isJuvixMarkdownFile p = case splitExtension p of
|
||||
Just (f, ext) -> ext == juvixMarkdownFileExt && isJuvixFile f
|
||||
Just (f, ext) -> ext == markdownFileExt && isJuvixFile f
|
||||
_ -> False
|
||||
|
||||
isJuvixGebFile :: Path b File -> Bool
|
||||
|
||||
@ -107,6 +107,9 @@ intervalEndLine a = a ^. intervalEnd . locLine . unPos . to fromIntegral
|
||||
intervalStartLine :: Interval -> Int
|
||||
intervalStartLine a = a ^. intervalStart . locLine . unPos . to fromIntegral
|
||||
|
||||
intervalStartCol :: Interval -> Int
|
||||
intervalStartCol a = a ^. intervalStart . locCol . unPos . to fromIntegral
|
||||
|
||||
intervalStartLoc :: Interval -> Loc
|
||||
intervalStartLoc i =
|
||||
Loc
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
module Juvix.Parser.Error where
|
||||
|
||||
import Commonmark qualified as MK
|
||||
import Juvix.Compiler.Concrete.Language
|
||||
import Juvix.Compiler.Concrete.Pretty.Options (fromGenericOptions)
|
||||
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.PathResolver.Error
|
||||
@ -8,9 +9,12 @@ import Juvix.Extra.Paths
|
||||
import Juvix.Prelude
|
||||
import Text.Megaparsec qualified as M
|
||||
import Text.Megaparsec.Error (errorOffset)
|
||||
import Text.Parsec.Error qualified as P
|
||||
import Text.Parsec.Pos qualified as P
|
||||
|
||||
data ParserError
|
||||
= ErrMegaparsec MegaparsecError
|
||||
| ErrCommonmark CommonmarkError
|
||||
| ErrTopModulePath TopModulePathError
|
||||
| ErrWrongTopModuleName WrongTopModuleName
|
||||
| ErrStdinOrFile StdinOrFileError
|
||||
@ -20,6 +24,7 @@ data ParserError
|
||||
instance ToGenericError ParserError where
|
||||
genericError = \case
|
||||
ErrMegaparsec e -> genericError e
|
||||
ErrCommonmark e -> genericError e
|
||||
ErrTopModulePath e -> genericError e
|
||||
ErrWrongTopModuleName e -> genericError e
|
||||
ErrStdinOrFile e -> genericError e
|
||||
@ -34,6 +39,7 @@ instance HasLoc MegaparsecError where
|
||||
state :: M.PosState Text
|
||||
state = M.bundlePosState b
|
||||
offset = errorOffset (head (M.bundleErrors b))
|
||||
|
||||
sourcePos :: M.SourcePos
|
||||
sourcePos =
|
||||
(snd . head . fst)
|
||||
@ -55,6 +61,42 @@ instance ToGenericError MegaparsecError where
|
||||
where
|
||||
i = getLoc e
|
||||
|
||||
newtype CommonmarkError = CommonmarkError
|
||||
{ _commonMarkError :: MK.ParseError
|
||||
}
|
||||
deriving stock (Show)
|
||||
|
||||
instance Pretty CommonmarkError where
|
||||
pretty (CommonmarkError e) =
|
||||
mconcat
|
||||
. intersperse line
|
||||
$ fmap (pretty . P.messageString) (P.errorMessages e)
|
||||
|
||||
instance HasLoc CommonmarkError where
|
||||
getLoc (CommonmarkError b) = singletonInterval (mkLoc 0 sourcePos)
|
||||
where
|
||||
sourcePos' :: P.SourcePos
|
||||
sourcePos' = P.errorPos b
|
||||
|
||||
sourcePos :: M.SourcePos
|
||||
sourcePos =
|
||||
M.SourcePos
|
||||
{ M.sourceName = P.sourceName sourcePos',
|
||||
M.sourceLine = M.mkPos $ P.sourceLine sourcePos',
|
||||
M.sourceColumn = M.mkPos $ P.sourceColumn sourcePos'
|
||||
}
|
||||
|
||||
instance ToGenericError CommonmarkError where
|
||||
genericError e =
|
||||
return
|
||||
GenericError
|
||||
{ _genericErrorLoc = i,
|
||||
_genericErrorMessage = mkAnsiText $ pretty @_ @AnsiStyle e,
|
||||
_genericErrorIntervals = [i]
|
||||
}
|
||||
where
|
||||
i = getLoc e
|
||||
|
||||
data TopModulePathError = TopModulePathError
|
||||
{ _topModulePathErrorPath :: TopModulePath,
|
||||
_topModulePathError :: PathResolverError
|
||||
|
||||
@ -123,14 +123,16 @@ toAnsiText useColors
|
||||
toPlainText :: (HasTextBackend a) => a -> Text
|
||||
toPlainText = Text.renderStrict . toTextStream
|
||||
|
||||
toPlainTextTrim :: (HasTextBackend a) => a -> Text
|
||||
toPlainTextTrim =
|
||||
trimText :: Text -> Text
|
||||
trimText =
|
||||
Text.unlines
|
||||
. map Text.stripEnd
|
||||
. dropWhileEnd Text.null
|
||||
. dropWhile Text.null
|
||||
. Text.lines
|
||||
. toPlainText
|
||||
|
||||
toPlainTextTrim :: (HasTextBackend a) => a -> Text
|
||||
toPlainTextTrim = trimText . toPlainText
|
||||
|
||||
prettyText :: (Pretty a) => a -> Text
|
||||
prettyText = Text.renderStrict . layoutPretty defaultLayoutOptions . pretty
|
||||
|
||||
87
test/Markdown.hs
Normal file
87
test/Markdown.hs
Normal file
@ -0,0 +1,87 @@
|
||||
module Markdown where
|
||||
|
||||
import Base
|
||||
import Juvix.Compiler.Backend.Markdown.Translation.FromTyped.Source
|
||||
import Juvix.Compiler.Concrete qualified as Concrete
|
||||
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
|
||||
import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser
|
||||
import Juvix.Compiler.Pipeline.Setup
|
||||
|
||||
data PosTest = PosTest
|
||||
{ _name :: String,
|
||||
_dir :: Path Abs Dir,
|
||||
_file :: Path Abs File,
|
||||
_expectedFile :: Path Abs File,
|
||||
_UrlPrefix :: Text,
|
||||
_IdPrefix :: Text,
|
||||
_NoPath :: Bool
|
||||
}
|
||||
|
||||
makeLenses ''PosTest
|
||||
|
||||
root :: Path Abs Dir
|
||||
root = relToProject $(mkRelDir "tests/positive/Markdown")
|
||||
|
||||
posTest :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> Text -> Text -> Bool -> PosTest
|
||||
posTest _name rdir rfile efile _UrlPrefix _IdPrefix _NoPath =
|
||||
let _dir = root <//> rdir
|
||||
_file = _dir <//> rfile
|
||||
_expectedFile = _dir <//> efile
|
||||
in PosTest {..}
|
||||
|
||||
testDescr :: PosTest -> TestDescr
|
||||
testDescr PosTest {..} =
|
||||
TestDescr
|
||||
{ _testName = _name,
|
||||
_testRoot = _dir,
|
||||
_testAssertion = Steps $ \step -> do
|
||||
entryPoint <- defaultEntryPointCwdIO _file
|
||||
step "Parsing"
|
||||
p :: Parser.ParserResult <- snd <$> runIO' entryPoint upToParsing
|
||||
step "Scoping"
|
||||
s :: Scoper.ScoperResult <-
|
||||
snd
|
||||
<$> runIO'
|
||||
entryPoint
|
||||
( do
|
||||
void (entrySetup defaultDependenciesConfig)
|
||||
Concrete.fromParsed p
|
||||
)
|
||||
let m = head (s ^. Scoper.resultModules)
|
||||
let opts =
|
||||
ProcessJuvixBlocksArgs
|
||||
{ _processJuvixBlocksArgsConcreteOpts = Concrete.defaultOptions,
|
||||
_processJuvixBlocksArgsUrlPrefix = _UrlPrefix,
|
||||
_processJuvixBlocksArgsIdPrefix = _IdPrefix,
|
||||
_processJuvixBlocksArgsNoPath = _NoPath,
|
||||
_processJuvixBlocksArgsComments =
|
||||
s ^. Scoper.comments,
|
||||
_processJuvixBlocksArgsModule = m,
|
||||
_processJuvixBlocksArgsOutputDir =
|
||||
root <//> $(mkRelDir "markdown")
|
||||
}
|
||||
|
||||
let md :: Text = fromJuvixMarkdown' opts
|
||||
|
||||
step "Checking against expected output file"
|
||||
expFile :: Text <- readFile (toFilePath _expectedFile)
|
||||
assertEqDiffText "Compare to expected output" md expFile
|
||||
}
|
||||
|
||||
allTests :: TestTree
|
||||
allTests =
|
||||
testGroup
|
||||
"Format positive tests"
|
||||
(map (mkTest . testDescr) tests)
|
||||
|
||||
tests :: [PosTest]
|
||||
tests =
|
||||
[ posTest
|
||||
"Test Markdown"
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "Test.juvix.md")
|
||||
$(mkRelFile "markdown/Test.md")
|
||||
"X"
|
||||
"Y"
|
||||
True
|
||||
]
|
||||
@ -300,7 +300,11 @@ tests =
|
||||
posTest
|
||||
"Instance axiom"
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "InstanceAxiom.juvix")
|
||||
$(mkRelFile "InstanceAxiom.juvix"),
|
||||
posTest
|
||||
"Markdown"
|
||||
$(mkRelDir "Markdown")
|
||||
$(mkRelFile "Test.juvix.md")
|
||||
]
|
||||
<> [ compilationTest t | t <- Compilation.tests
|
||||
]
|
||||
|
||||
29
tests/positive/Markdown/Test.juvix.md
Normal file
29
tests/positive/Markdown/Test.juvix.md
Normal file
@ -0,0 +1,29 @@
|
||||
# Example
|
||||
|
||||
A Juvix Markdown file name ends with `.juvix.md`. This kind of file must contain
|
||||
a module declaration at the top, as shown below ---in the first code block.
|
||||
|
||||
```juvix
|
||||
module Test;
|
||||
```
|
||||
|
||||
Certain blocks can be hidden from the output by adding the `hide` attribute, as shown below.
|
||||
|
||||
```juvix hide
|
||||
import Stdlib.Prelude open;
|
||||
```
|
||||
|
||||
```juvix
|
||||
fib : Nat → Nat → Nat → Nat
|
||||
| zero x1 _ := x1
|
||||
|
||||
| (suc n) x1 x2 := fib n x2 (x1 + x2);
|
||||
|
||||
fibonacci (n : Nat) : Nat := fib n 0 1;
|
||||
```
|
||||
|
||||
Commands like `typecheck` and `compile` can be used with Juvix Markdown files.
|
||||
|
||||
```juvix
|
||||
main : IO := readLn (printNatLn ∘ fibonacci ∘ stringToNat);
|
||||
```
|
||||
0
tests/positive/Markdown/juvix.yaml
Normal file
0
tests/positive/Markdown/juvix.yaml
Normal file
20
tests/positive/Markdown/markdown/Test.md
Normal file
20
tests/positive/Markdown/markdown/Test.md
Normal file
@ -0,0 +1,20 @@
|
||||
# Example
|
||||
|
||||
A Juvix Markdown file name ends with `.juvix.md`. This kind of file must contain
|
||||
a module declaration at the top, as shown below ---in the first code block.
|
||||
|
||||
<pre class="highlight"><code class="juvix"><pre class="src-content"><span class="ju-keyword">module</span> <span id="Y0"><span class="annot"><a href="X#Y0"><span class="annot"><a href="X#Y0"><span class="ju-var">Test</span></a></span></a></span></span><span class="ju-delimiter">;</span>
|
||||
</pre></code></pre>
|
||||
|
||||
Certain blocks can be hidden from the output by adding the `hide` attribute, as shown below.
|
||||
|
||||
|
||||
<pre class="highlight"><code class="juvix"><pre class="src-content"><span id="Y740"><span class="annot"><a href="X#Y740"><span class="annot"><a href="X#Y740"><span class="ju-function">fib</span></a></span></a></span></span> <span class="ju-keyword">:</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span> <span class="ju-keyword">→</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span> <span class="ju-keyword">→</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span> <span class="ju-keyword">→</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span>
|
||||
<span class="ju-keyword">|</span> <span class="annot"><a href="X#Y112"><span class="ju-constructor">zero</span></a></span> <span id="Y743"><span class="annot"><a href="X#Y743"><span class="annot"><a href="X#Y743"><span class="ju-var">x1</span></a></span></a></span></span> <span class="ju-keyword">_</span> <span class="ju-keyword">:=</span> <span class="annot"><a href="X#Y743"><span class="ju-var">x1</span></a></span>
|
||||
<span class="ju-keyword">|</span> <span class="annot"><a href="X#Y113"><span class="ju-constructor"><span class="ju-delimiter">(</span>suc</span></a></span> <span id="Y744"><span class="annot"><a href="X#Y744"><span class="annot"><a href="X#Y744"><span class="ju-var">n</span></a></span></a></span></span><span class="ju-delimiter">)</span> <span id="Y745"><span class="annot"><a href="X#Y745"><span class="annot"><a href="X#Y745"><span class="ju-var">x1</span></a></span></a></span></span> <span id="Y746"><span class="annot"><a href="X#Y746"><span class="annot"><a href="X#Y746"><span class="ju-var">x2</span></a></span></a></span></span> <span class="ju-keyword">:=</span> <span class="annot"><a href="X#Y740"><span class="ju-function">fib</span></a></span> <span class="annot"><a href="X#Y744"><span class="ju-var">n</span></a></span> <span class="annot"><a href="X#Y746"><span class="ju-var">x2</span></a></span> <span class="annot"><a href="X#Y745"><span class="ju-var"><span class="ju-delimiter">(</span>x1</span></a></span> <span class="annot"><a href="X#Y510"><span class="ju-function">+</span></a></span> <span class="annot"><a href="X#Y746"><span class="ju-var">x2</span></a></span><span class="ju-delimiter">)</span><span class="ju-delimiter">;</span>
|
||||
|
||||
<span id="Y741"><span class="annot"><a href="X#Y741"><span class="annot"><a href="X#Y741"><span class="ju-function">fibonacci</span></a></span></a></span></span> <span class="ju-delimiter">(</span><span class="annot"><a href="X#Y747"><span class="ju-var">n</span></a></span> <span class="ju-keyword">:</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span><span class="ju-delimiter">)</span> <span class="ju-keyword">:</span> <span class="annot"><a href="X#Y111"><span class="ju-inductive">Nat</span></a></span> <span class="ju-keyword">:=</span> <span class="annot"><a href="X#Y740"><span class="ju-function">fib</span></a></span> <span class="annot"><a href="X#Y747"><span class="ju-var">n</span></a></span> <span class="ju-number">0</span> <span class="ju-number">1</span><span class="ju-delimiter">;</span></pre></code></pre>
|
||||
|
||||
Commands like `typecheck` and `compile` can be used with Juvix Markdown files.
|
||||
|
||||
<pre class="highlight"><code class="juvix"><pre class="src-content"><span id="Y742"><span class="annot"><a href="X#Y742"><span class="annot"><a href="X#Y742"><span class="ju-function">main</span></a></span></a></span></span> <span class="ju-keyword">:</span> <span class="annot"><a href="X#Y714"><span class="ju-axiom">IO</span></a></span> <span class="ju-keyword">:=</span> <span class="annot"><a href="X#Y719"><span class="ju-axiom">readLn</span></a></span> <span class="annot"><a href="X#Y727"><span class="ju-function"><span class="ju-delimiter">(</span>printNatLn</span></a></span> <span class="annot"><a href="X#Y188"><span class="ju-function">∘</span></a></span> <span class="annot"><a href="X#Y741"><span class="ju-function">fibonacci</span></a></span> <span class="annot"><a href="X#Y188"><span class="ju-function">∘</span></a></span> <span class="annot"><a href="X#Y551"><span class="ju-axiom">stringToNat</span></a></span><span class="ju-delimiter">)</span><span class="ju-delimiter">;</span></pre></code></pre>
|
||||
92
tests/smoke/Commands/markdown.smoke.yaml
Normal file
92
tests/smoke/Commands/markdown.smoke.yaml
Normal file
@ -0,0 +1,92 @@
|
||||
working-directory: ./../../positive/Markdown
|
||||
|
||||
tests:
|
||||
- name: markdown-help-theme
|
||||
command:
|
||||
- juvix
|
||||
- markdown
|
||||
- --help
|
||||
stdout:
|
||||
contains: JUVIX_MARKDOWN_FILE
|
||||
exit-status: 0
|
||||
|
||||
- name: markdown-stdout
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cp Test.juvix.md $temp
|
||||
cd $temp
|
||||
touch juvix.yaml
|
||||
juvix markdown Test.juvix.md --stdout
|
||||
stdout:
|
||||
contains:
|
||||
<pre class="highlight"><code class="juvix">
|
||||
exit-status: 0
|
||||
|
||||
- name: output-dir
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cp Test.juvix.md $temp
|
||||
cd $temp
|
||||
touch juvix.yaml
|
||||
juvix markdown Test.juvix.md --output-dir=OUT
|
||||
[ -d OUT ]
|
||||
[ -f OUT/Test.md ]
|
||||
stdout: ''
|
||||
exit-status: 0
|
||||
|
||||
- name: markdown-id-prefix
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cp Test.juvix.md $temp
|
||||
cd $temp
|
||||
touch juvix.yaml
|
||||
juvix markdown Test.juvix.md --prefix-id="XYZ"
|
||||
cat markdown/Test.md
|
||||
stdout:
|
||||
matches: |
|
||||
.*href="Test.html#XYZ[0-9]+".*
|
||||
exit-status: 0
|
||||
|
||||
- name: markdown-no-path
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cp Test.juvix.md $temp
|
||||
cd $temp
|
||||
touch juvix.yaml
|
||||
juvix markdown Test.juvix.md --no-path --stdout
|
||||
stdout:
|
||||
matches: |
|
||||
.*href="#[0-9]+".*
|
||||
exit-status: 0
|
||||
|
||||
- name: markdown-options-for-mkdocs
|
||||
command:
|
||||
shell:
|
||||
- bash
|
||||
script: |
|
||||
temp=$(mktemp -d)
|
||||
trap 'rm -rf -- "$temp"' EXIT
|
||||
cp Test.juvix.md $temp
|
||||
cd $temp
|
||||
touch juvix.yaml
|
||||
juvix markdown Test.juvix.md --no-path --prefix-url Y --prefix-id X --stdout
|
||||
stdout:
|
||||
matches: |
|
||||
.*href="Y#X[0-9]+".*
|
||||
exit-status: 0
|
||||
Loading…
Reference in New Issue
Block a user