Plain markdown support

app/Commands/Dev.hs

@@ -19,6 +19,7 @@ import Commands.Dev.MigrateJuvixYaml qualified as MigrateJuvixYaml
 import Commands.Dev.Nockma qualified as Nockma
 import Commands.Dev.Options
 import Commands.Dev.Parse qualified as Parse
+import Commands.Dev.PlainMarkdown qualified as PlainMarkdown
 import Commands.Dev.Reg qualified as Reg
 import Commands.Dev.Runtime qualified as Runtime
 import Commands.Dev.Scope qualified as Scope
@@ -47,3 +48,4 @@ runCommand = \case
   MigrateJuvixYaml opts -> runFilesIO $ MigrateJuvixYaml.runCommand opts
   Nockma opts -> Nockma.runCommand opts
   Anoma opts -> Anoma.runCommand opts
+  PlainMarkdown opts -> PlainMarkdown.runCommand opts

app/Commands/Dev/Options.hs

@@ -25,6 +25,7 @@ import Commands.Dev.Latex.Options
 import Commands.Dev.MigrateJuvixYaml.Options
 import Commands.Dev.Nockma.Options
 import Commands.Dev.Parse.Options
+import Commands.Dev.PlainMarkdown.Options
 import Commands.Dev.Reg.Options
 import Commands.Dev.Repl.Options
 import Commands.Dev.Runtime.Options
@@ -45,6 +46,7 @@ data DevCommand
   | Asm AsmCommand
   | Reg RegCommand
   | Tree TreeCommand
+  | PlainMarkdown PlainMarkdownCommand
   | Casm CasmCommand
   | Runtime RuntimeCommand
   | Parse ParseOptions
@@ -78,10 +80,18 @@ parseDevCommand =
           commandMigrateJuvixYaml,
           commandLatex,
           commandAnoma,
-          commandNockma
+          commandNockma,
+          commandPlainMarkdown
         ]
     )
 
+commandPlainMarkdown :: Mod CommandFields DevCommand
+commandPlainMarkdown =
+  command "plain-markdown" $
+    info
+      (PlainMarkdown <$> parsePlainMarkdownCommand)
+      (progDesc "Subcommands related to Markdown (without Juvix)")
+
 commandLatex :: Mod CommandFields DevCommand
 commandLatex =
   command "latex" $

app/Commands/Dev/PlainMarkdown.hs

@@ -0,0 +1,9 @@
+module Commands.Dev.PlainMarkdown where
+
+import Commands.Base
+import Commands.Dev.PlainMarkdown.Format qualified as Format
+import Commands.Dev.PlainMarkdown.Options
+
+runCommand :: forall r. (Members AppEffects r) => PlainMarkdownCommand -> Sem r ()
+runCommand = \case
+  Format opts -> Format.runCommand opts

app/Commands/Dev/PlainMarkdown/Format.hs

@@ -0,0 +1,16 @@
+module Commands.Dev.PlainMarkdown.Format where
+
+import Commands.Base
+import Commands.Dev.PlainMarkdown.Format.Options
+import Markdown.FromSource qualified as Markdown
+import Markdown.Print
+
+runCommand ::
+  forall r.
+  (Members AppEffects r) =>
+  FormatOptions ->
+  Sem r ()
+runCommand opts = do
+  afile <- fromAppPathFile (opts ^. formatFile)
+  mdBlock <- runAppError @SimpleError (Markdown.parseFile afile)
+  renderStdOutLn (ppOut mdBlock)

app/Commands/Dev/PlainMarkdown/Format/Options.hs

@@ -0,0 +1,15 @@
+module Commands.Dev.PlainMarkdown.Format.Options where
+
+import CommonOptions
+
+newtype FormatOptions = FormatOptions
+  { _formatFile :: AppPath File
+  }
+  deriving stock (Data)
+
+makeLenses ''FormatOptions
+
+parseFormatOptions :: Parser FormatOptions
+parseFormatOptions = do
+  _formatFile <- parseInputFile FileExtMarkdown
+  pure FormatOptions {..}

app/Commands/Dev/PlainMarkdown/Options.hs

@@ -0,0 +1,24 @@
+module Commands.Dev.PlainMarkdown.Options where
+
+import Commands.Dev.PlainMarkdown.Format.Options
+import CommonOptions
+
+data PlainMarkdownCommand
+  = Format FormatOptions
+  deriving stock (Data)
+
+parsePlainMarkdownCommand :: Parser PlainMarkdownCommand
+parsePlainMarkdownCommand =
+  hsubparser $
+    mconcat
+      [ commandFormat
+      ]
+  where
+    commandFormat :: Mod CommandFields PlainMarkdownCommand
+    commandFormat = command "format" formatInfo
+      where
+        formatInfo :: ParserInfo PlainMarkdownCommand
+        formatInfo =
+          info
+            (Format <$> parseFormatOptions)
+            (progDesc "Format a plain markdown file (no Juvix involved)")

app/CommonOptions.hs

@@ -47,7 +47,7 @@ instance Show (AppPath f) where
 
 parseInputFilesMod :: NonEmpty FileExt -> Mod ArgumentFields (Prepath File) -> Parser (AppPath File)
 parseInputFilesMod exts' mods = do
-  let exts = NonEmpty.toList exts'
+  let exts = toList exts'
       mvars = intercalate "|" (map toMetavar exts)
       dotExts = intercalate ", " (map show exts)
       helpMsg = "Path to a " <> dotExts <> " file"

app/TopCommand.hs

@@ -1,6 +1,6 @@
 module TopCommand where
 
-import Commands.Base hiding (Format)
+import Commands.Base
 import Commands.Clean qualified as Clean
 import Commands.Compile qualified as Compile
 import Commands.Dependencies qualified as Dependencies

src/Juvix/Compiler/Backend/Markdown/Data/Types.hs

@@ -4,7 +4,7 @@ module Juvix.Compiler.Backend.Markdown.Data.Types
   )
 where
 
-import Commonmark qualified as MK
+import Commonmark qualified as CM
 import Data.Text qualified as T
 import Juvix.Compiler.Backend.Markdown.Data.MkJuvixBlockOptions
 import Juvix.Data.Loc
@@ -90,13 +90,13 @@ instance Monoid Mk where
 nl :: Text
 nl = "\n"
 
-instance MK.ToPlainText TextBlock where
+instance CM.ToPlainText TextBlock where
   toPlainText r = r ^. textBlock
 
-instance MK.ToPlainText JuvixCodeBlock where
+instance CM.ToPlainText JuvixCodeBlock where
   toPlainText = show
 
-instance MK.ToPlainText Mk where
+instance CM.ToPlainText Mk where
   toPlainText =
     trimText
       . mconcat
@@ -112,7 +112,7 @@ builder = \case
 flatten :: [Mk] -> Mk
 flatten = foldl' (<>) MkNull
 
-instance MK.Rangeable Mk where
+instance CM.Rangeable Mk where
   ranged _ x = x
 
 toTextBlock :: Text -> TextBlock
@@ -145,16 +145,16 @@ paren = wrap' "(" ")"
 brack :: TextBlock -> TextBlock
 brack = wrap' "[" "]"
 
-instance MK.HasAttributes TextBlock where
+instance CM.HasAttributes TextBlock where
   addAttributes _ = id
 
-instance MK.Rangeable TextBlock where
+instance CM.Rangeable TextBlock where
   ranged _ r = r
 
-instance MK.HasAttributes Mk where
+instance CM.HasAttributes Mk where
   addAttributes _ = id
 
-instance MK.IsInline TextBlock where
+instance CM.IsInline TextBlock where
   lineBreak = toTextBlock nl
   softBreak = toTextBlock " "
   str = toTextBlock
@@ -168,7 +168,7 @@ instance MK.IsInline TextBlock where
     toTextBlock "!" <> brack desc <> paren (toTextBlock src)
   code = wrap "`" . toTextBlock
   rawInline f t
-    | f == MK.Format "html" =
+    | f == CM.Format "html" =
         toTextBlock t
     | otherwise = mempty
 
@@ -189,7 +189,7 @@ processCodeBlock info t loc =
       let b = "```" <> info <> t <> "```"
        in MkTextBlock TextBlock {_textBlock = b, _textBlockInterval = loc}
 
-instance MK.IsBlock TextBlock Mk where
+instance CM.IsBlock TextBlock Mk where
   paragraph a = MkTextBlock a
   plain a = MkTextBlock a
   thematicBreak = toMK "---"

src/Juvix/Compiler/Concrete/Translation/FromSource.hs

@@ -161,11 +161,11 @@ runModuleParser fileName input_
       res <- P.runParserT juvixCodeBlockParser (toFilePath fileName) input_
       case res of
         Left err -> return . Left . ErrMegaparsec . MegaparsecError $ err
-        Right r
-          | MK.nullMk r ->
+        Right mk
+          | MK.nullMk mk ->
               return . Left . ErrMarkdownBackend $
                 ErrNoJuvixCodeBlocks NoJuvixCodeBlocksError {_noJuvixCodeBlocksErrorFilepath = fileName}
-          | otherwise -> runMarkdownModuleParser fileName r
+          | otherwise -> runMarkdownModuleParser fileName mk
   | otherwise = do
       m <-
         evalState (Nothing @ParsedPragmas)

src/Juvix/Prelude/Base/Foundation.hs

@@ -133,7 +133,7 @@ import Data.Bifunctor hiding (first, second)
 import Data.Bitraversable
 import Data.Bool
 import Data.ByteString (ByteString)
-import Data.Char
+import Data.Char hiding (Format)
 import Data.Char qualified as Char
 import Data.Data
 import Data.Either.Extra
@@ -308,9 +308,12 @@ compose n f a = f (compose (n - 1) f a)
 -- String related util functions.
 --------------------------------------------------------------------------------
 
-show :: (Show a, IsString str) => a -> str
+show :: forall str a. (Show a, IsString str) => a -> str
 show = fromString . Show.show
 
+showEscapedChar :: Char -> Text
+showEscapedChar c = pack (showLitChar c "")
+
 toUpperFirst :: String -> String
 toUpperFirst [] = []
 toUpperFirst (x : xs) = Char.toUpper x : xs
@@ -910,8 +913,11 @@ graphCycle gi =
         goChildren :: NonEmpty Vertex -> [Tree Vertex] -> Either (NonEmpty Vertex) ()
         goChildren path = mapM_ (go path)
 
+allNaturalsFrom :: Natural -> Stream Natural
+allNaturalsFrom start = Stream.iterate succ start
+
 allNaturals :: Stream Natural
-allNaturals = Stream.iterate succ 0
+allNaturals = allNaturalsFrom 0
 
 allWords :: Stream Text
 allWords = pack . toList <$> allFiniteSequences ('a' :| ['b' .. 'z'])

src/Markdown/FromSource.hs

@@ -0,0 +1,15 @@
+-- | Import this module qualified
+module Markdown.FromSource (parseText, parseFile) where
+
+import Commonmark.Parser
+import Juvix.Prelude
+import Markdown.Language
+
+parseFile :: (Members '[Files, Error SimpleError] r) => Path Abs File -> Sem r Blocks
+parseFile inputFile = readFile' inputFile >>= parseText inputFile
+
+parseText :: (Members '[Error SimpleError] r) => Path Abs File -> Text -> Sem r Blocks
+parseText inputFile txt = do
+  case commonmark (toFilePath inputFile) txt of
+    Left err -> throw (SimpleError ("markdown parse error: " <> show err))
+    Right block -> return block