Fix highlighting of comments (#3226)

`highlightParsedItem` was not being called for comments
anoma · Dec 6, 2024 · 5029a56 · 5029a56
1 parent 69c629b
commit 5029a56
Show file tree

Hide file tree

Showing 15 changed files with 30 additions and 28 deletions.
diff --git a/app/Commands/Dev/Nockma/Format.hs b/app/Commands/Dev/Nockma/Format.hs
@@ -10,7 +10,7 @@ runCommand opts = do
   afile <- fromAppPathFile file
   parsedTerm <-
     runAppError @JuvixError
-      . Nockma.ignoreHighlightBuilder
+      . Nockma.evalHighlightBuilder
       $ Nockma.parseTermFile afile
   putStrLn (ppPrint parsedTerm)
   where

diff --git a/app/Commands/Dev/Nockma/Ide/Check.hs b/app/Commands/Dev/Nockma/Ide/Check.hs
@@ -10,6 +10,6 @@ runCommand opts = do
   afile <- fromAppPathFile (opts ^. nockmaCheckFile)
   void
     . runAppError @JuvixError
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     $ Nockma.parseTermFile afile
   renderStdOutLn ("Ok" :: Text)
diff --git a/src/Juvix/Compiler/Concrete/Data/Highlight/Builder.hs b/src/Juvix/Compiler/Concrete/Data/Highlight/Builder.hs
@@ -34,8 +34,8 @@ runHighlightBuilder = reinterpret (runStateShared emptyHighlightInput) $ \case
   HighlightMergeDocTable tbl -> modifyShared (over highlightDocTable (HashMap.union tbl))
   GetDocTable uid -> filterByTopModule uid <$> getsShared (^. highlightDocTable)
 
-ignoreHighlightBuilder :: Sem (HighlightBuilder ': r) a -> Sem r a
-ignoreHighlightBuilder = fmap snd . runHighlightBuilder
+evalHighlightBuilder :: Sem (HighlightBuilder ': r) a -> Sem r a
+evalHighlightBuilder = fmap snd . runHighlightBuilder
 
 runJuvixError :: (Members '[HighlightBuilder] r) => Sem (Error JuvixError ': r) a -> Sem r (Either JuvixError a)
 runJuvixError m = do

diff --git a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs
@@ -138,7 +138,7 @@ registerBuiltinHelper b n = do
             }
 
 runInfoTableBuilderRepl :: (Members '[Error ScoperError] r) => InfoTable -> Sem (InfoTableBuilder ': r) a -> Sem r (InfoTable, a)
-runInfoTableBuilderRepl tab = ignoreHighlightBuilder . runInfoTableBuilder tab . raiseUnder
+runInfoTableBuilderRepl tab = evalHighlightBuilder . runInfoTableBuilder tab . raiseUnder
 
 ignoreInfoTableBuilder :: (Members '[Error ScoperError, HighlightBuilder] r) => Sem (InfoTableBuilder ': r) a -> Sem r a
 ignoreInfoTableBuilder = fmap snd . runInfoTableBuilder mempty

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs
@@ -105,7 +105,7 @@ scopeCheckRepl ::
   Sem r b
 scopeCheckRepl check importTab tab a =
   mapError (JuvixError @ScoperError)
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     . evalInfoTableBuilder tab
     . runReader iniScopeParameters
     . runReader tab'
@@ -3215,7 +3215,7 @@ checkJudoc ::
   Judoc 'Parsed ->
   Sem r (Judoc 'Scoped)
 checkJudoc (Judoc groups) =
-  ignoreHighlightBuilder
+  evalHighlightBuilder
     . ignoreInfoTableBuilder
     $ Judoc <$> mapM checkJudocGroup groups
 

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
@@ -17,7 +17,7 @@ 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.Backend.Markdown.Error
-import Juvix.Compiler.Concrete (HighlightBuilder, ignoreHighlightBuilder)
+import Juvix.Compiler.Concrete (HighlightBuilder, evalHighlightBuilder)
 import Juvix.Compiler.Concrete.Extra (takeWhile1P)
 import Juvix.Compiler.Concrete.Extra qualified as P
 import Juvix.Compiler.Concrete.Gen qualified as Gen
@@ -294,7 +294,7 @@ runExpressionParser ::
   Sem r (Either ParserError (ExpressionAtoms 'Parsed))
 runExpressionParser fpath input_ = do
   m <-
-    ignoreHighlightBuilder
+    evalHighlightBuilder
       . evalParserResultBuilder mempty
       . evalState (Nothing @ParsedPragmas)
       . evalState (Nothing @(Judoc 'Parsed))

diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/ParserResultBuilder.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource/ParserResultBuilder.hs
@@ -95,12 +95,14 @@ runParserResultBuilder s =
       registerItem' i
     RegisterSpaceSpan g -> do
       modify' (over parserStateComments (g :))
-      forM_ (g ^.. spaceSpan . each . _SpaceComment) $ \c ->
-        registerItem'
-          ParsedItem
-            { _parsedLoc = getLoc c,
-              _parsedTag = ParsedTagComment
-            }
+      forM_ (g ^.. spaceSpan . each . _SpaceComment) $ \c -> do
+        let i =
+              ParsedItem
+                { _parsedLoc = getLoc c,
+                  _parsedTag = ParsedTagComment
+                }
+        highlightParsedItem i
+        registerItem' i
 
 ignoreParserResultBuilder :: Sem (ParserResultBuilder ': r) a -> Sem r a
 ignoreParserResultBuilder = interpret $ \case

diff --git a/src/Juvix/Compiler/Concrete/Translation/ImportScanner/Megaparsec.hs b/src/Juvix/Compiler/Concrete/Translation/ImportScanner/Megaparsec.hs
@@ -21,7 +21,7 @@ scanBSImports ::
   Sem r ScanResult
 scanBSImports fp inputBS = do
   st <-
-    ignoreHighlightBuilder
+    evalHighlightBuilder
       . execParserResultBuilder mempty
       . ignoreTopModuleNameChecker
       $ runModuleParser fp (decodeUtf8 inputBS)

diff --git a/src/Juvix/Compiler/Internal/Translation/Repl.hs b/src/Juvix/Compiler/Internal/Translation/Repl.hs
@@ -24,7 +24,7 @@ typeCheckExpressionType exp = do
   stable <- gets (^. artifactScopeTable)
   runResultBuilderArtifacts
     . runNameIdGenArtifacts
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     . runReader table
     . runReader (stable ^. infoBuiltins)
     . runReader stable

diff --git a/src/Juvix/Compiler/Nockma/Highlight/Input.hs b/src/Juvix/Compiler/Nockma/Highlight/Input.hs
@@ -39,8 +39,8 @@ data HighlightBuilder :: Effect where
 
 makeSem ''HighlightBuilder
 
-ignoreHighlightBuilder :: Sem (HighlightBuilder ': r) a -> Sem r a
-ignoreHighlightBuilder = interpret $ \case
+evalHighlightBuilder :: Sem (HighlightBuilder ': r) a -> Sem r a
+evalHighlightBuilder = interpret $ \case
   HighlightItem {} -> return ()
   HighlightNockOp {} -> return ()
   HighlightPath {} -> return ()

diff --git a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs
@@ -40,7 +40,7 @@ cueJammedFileOrPretty ::
   Prelude.Path Abs File ->
   Sem r (Term Natural)
 cueJammedFileOrPretty f
-  | f `hasExtensions` nockmaDebugFileExts = ignoreHighlightBuilder (parseTermFile f)
+  | f `hasExtensions` nockmaDebugFileExts = evalHighlightBuilder (parseTermFile f)
   | otherwise = cueJammedFile f
 
 -- | If the file ends in .debug.nockma it parses an annotated unjammed program. Otherwise
@@ -114,7 +114,7 @@ runParserForSem p f txt = do
     Right t -> return t
 
 runParserFor :: Parser a -> Prelude.Path Abs File -> Text -> Either MegaparsecError a
-runParserFor p f = run . ignoreHighlightBuilder . runError . runParserForSem p f
+runParserFor p f = run . evalHighlightBuilder . runError . runParserForSem p f
 
 runParser :: Prelude.Path Abs File -> Text -> Either MegaparsecError (Term Natural)
 runParser = runParserFor term

diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/EvalEff/IO.hs
@@ -126,7 +126,7 @@ loadPackage' packagePath = do
     . runConcurrent
     . ignoreLogger
     . evalInternetOffline
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     . runProcessIO
     . runFilesIO
     . evalTopNameIdGen defaultModuleId

diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs
@@ -1,6 +1,6 @@
 module Juvix.Compiler.Pipeline.Repl where
 
-import Juvix.Compiler.Concrete (ignoreHighlightBuilder)
+import Juvix.Compiler.Concrete (evalHighlightBuilder)
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Translation.FromParsed qualified as Scoper
 import Juvix.Compiler.Concrete.Translation.FromSource qualified as Parser
@@ -89,7 +89,7 @@ parseReplInput ::
   Text ->
   Sem r Parser.ReplInput
 parseReplInput fp txt =
-  ignoreHighlightBuilder
+  evalHighlightBuilder
     . runNameIdGenArtifacts
     . runStateLikeArtifacts runParserResultBuilder artifactParsing
     $ Parser.replInputFromTextSource fp txt
@@ -165,7 +165,7 @@ compileReplInputIO fp txt = do
     . runLoggerIO replLoggerOptions
     . runReader defaultNumThreads
     . evalInternet hasInternet
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     . runTaggedLockPermissive
     . runFilesIO
     . mapError (JuvixError @GitProcessError)

diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs
@@ -215,7 +215,7 @@ runReplPipelineIOEither' lockMode entry = do
       . runConcurrent
       . runReader defaultNumThreads
       . evalInternet hasInternet
-      . ignoreHighlightBuilder
+      . evalHighlightBuilder
       . runError
       . runState initialArtifacts
       . runNameIdGenArtifacts

diff --git a/src/Juvix/Formatter.hs b/src/Juvix/Formatter.hs
@@ -2,7 +2,7 @@
 
 module Juvix.Formatter where
 
-import Juvix.Compiler.Concrete.Data.Highlight.Builder (ignoreHighlightBuilder)
+import Juvix.Compiler.Concrete.Data.Highlight.Builder (evalHighlightBuilder)
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Print (ppOutDefault)
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping (ScoperResult, getModuleId, scopeCheck)
@@ -118,7 +118,7 @@ formatModuleInfo ::
   Sem r SourceCode
 formatModuleInfo node moduleInfo =
   withResolverRoot (node ^. importNodePackageRoot)
-    . ignoreHighlightBuilder
+    . evalHighlightBuilder
     $ do
       pkg :: PackageId <- ask
       parseRes :: ParserResult <-