Nockma mode (#3163)

Support for emacs
[nockma-mode](anoma/juvix-mode#25). The list of
features is given in the link.

It adds the following commands:
1. `juvix dev nockma ide check`. Parses a nockma file (used by flycheck
only).
2. `juvix dev nockma ide highlight`. Highlights a nockma file.
3. `juvix dev nockma ide rules`. Shows all evaluation rules properly
highlighted in emacs.

app/Commands/Dev/Latex/Export.hs

@@ -6,7 +6,6 @@ where
 
 import Commands.Base
 import Commands.Dev.Latex.Export.Options
-import Data.String.Interpolate (__i)
 import Data.Text qualified as Text
 import Juvix.Compiler.Backend.Latex.Translation.FromScoped.Source
 import Juvix.Compiler.Concrete.Language

app/Commands/Dev/Nockma.hs

@@ -4,6 +4,7 @@ import Commands.Base
 import Commands.Dev.Nockma.Encode as Encode
 import Commands.Dev.Nockma.Eval as Eval
 import Commands.Dev.Nockma.Format as Format
+import Commands.Dev.Nockma.Ide as Ide
 import Commands.Dev.Nockma.Options
 import Commands.Dev.Nockma.Repl as Repl
 import Commands.Dev.Nockma.Run as Run
@@ -15,3 +16,4 @@ runCommand = \case
   NockmaFormat opts -> Format.runCommand opts
   NockmaRun opts -> Run.runCommand opts
   NockmaEncode opts -> Encode.runCommand opts
+  NockmaIde opts -> Ide.runCommand opts

app/Commands/Dev/Nockma/Format.hs

@@ -8,7 +8,10 @@ import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
 runCommand :: forall r. (Members AppEffects r) => NockmaFormatOptions -> Sem r ()
 runCommand opts = do
   afile <- fromAppPathFile file
-  parsedTerm <- runAppError @JuvixError (Nockma.parseTermFile afile)
+  parsedTerm <-
+    runAppError @JuvixError
+      . Nockma.ignoreHighlightBuilder
+      $ Nockma.parseTermFile afile
   putStrLn (ppPrint parsedTerm)
   where
     file :: AppPath File

app/Commands/Dev/Nockma/Ide.hs

@@ -0,0 +1,17 @@
+module Commands.Dev.Nockma.Ide where
+
+import Commands.Base
+import Commands.Dev.Nockma.Ide.Check as Check
+import Commands.Dev.Nockma.Ide.Highlight as Highlight
+import Commands.Dev.Nockma.Ide.Options
+import Commands.Dev.Nockma.Ide.Rules as Rules
+
+runCommand ::
+  forall r.
+  (Members AppEffects r) =>
+  NockmaIdeCommand ->
+  Sem r ()
+runCommand = \case
+  NockmaIdeHighlight opts -> Highlight.runCommand opts
+  NockmaIdeCheck opts -> Check.runCommand opts
+  NockmaIdeRules {} -> Rules.runCommand

app/Commands/Dev/Nockma/Ide/Check.hs

@@ -0,0 +1,15 @@
+module Commands.Dev.Nockma.Ide.Check where
+
+import Commands.Base hiding (Atom)
+import Commands.Dev.Nockma.Ide.Check.Options
+import Juvix.Compiler.Nockma.Highlight
+import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
+
+runCommand :: forall r. (Members AppEffects r) => NockmaCheckOptions -> Sem r ()
+runCommand opts = do
+  afile <- fromAppPathFile (opts ^. nockmaCheckFile)
+  void
+    . runAppError @JuvixError
+    . ignoreHighlightBuilder
+    $ Nockma.parseTermFile afile
+  renderStdOutLn ("Ok" :: Text)

app/Commands/Dev/Nockma/Ide/Check/Options.hs

@@ -0,0 +1,15 @@
+module Commands.Dev.Nockma.Ide.Check.Options where
+
+import CommonOptions
+
+newtype NockmaCheckOptions = NockmaCheckOptions
+  { _nockmaCheckFile :: AppPath File
+  }
+  deriving stock (Data)
+
+makeLenses ''NockmaCheckOptions
+
+parseNockmaCheckOptions :: Parser NockmaCheckOptions
+parseNockmaCheckOptions = do
+  _nockmaCheckFile <- parseInputFile FileExtNockma
+  pure NockmaCheckOptions {..}

app/Commands/Dev/Nockma/Ide/Highlight.hs

@@ -0,0 +1,27 @@
+module Commands.Dev.Nockma.Ide.Highlight where
+
+import Commands.Base hiding (Atom)
+import Commands.Dev.Nockma.Ide.Highlight.Options
+import Juvix.Compiler.Nockma.Highlight
+import Juvix.Compiler.Nockma.Translation.FromSource qualified as Nockma
+
+runCommand :: forall r. (Members AppEffects r) => NockmaHighlightOptions -> Sem r ()
+runCommand opts = silenceProgressLog . runPipelineOptions $ do
+  afile <- fromAppPathFile (opts ^. nockmaHighlightFile)
+  hinput <-
+    fmap (filterInput afile)
+      . runJuvixErrorHighlight
+      . execHighlightBuilder
+      $ Nockma.parseTermFile afile
+  renderStdOutRaw (highlight hinput)
+  newline
+
+runJuvixErrorHighlight :: forall r. Sem (Error JuvixError ': r) HighlightInput -> Sem r HighlightInput
+runJuvixErrorHighlight m = do
+  res <- runError m
+  return $ case res of
+    Right r -> r
+    Left err ->
+      emptyHighlightInput
+        { _highlightErrors = [getLoc err]
+        }

app/Commands/Dev/Nockma/Ide/Highlight/Options.hs

@@ -0,0 +1,15 @@
+module Commands.Dev.Nockma.Ide.Highlight.Options where
+
+import CommonOptions
+
+newtype NockmaHighlightOptions = NockmaHighlightOptions
+  { _nockmaHighlightFile :: AppPath File
+  }
+  deriving stock (Data)
+
+makeLenses ''NockmaHighlightOptions
+
+parseNockmaHighlightOptions :: Parser NockmaHighlightOptions
+parseNockmaHighlightOptions = do
+  _nockmaHighlightFile <- parseInputFile FileExtNockma
+  pure NockmaHighlightOptions {..}

app/Commands/Dev/Nockma/Ide/Options.hs

@@ -0,0 +1,47 @@
+module Commands.Dev.Nockma.Ide.Options where
+
+import Commands.Dev.Nockma.Ide.Check.Options
+import Commands.Dev.Nockma.Ide.Highlight.Options
+import CommonOptions
+
+data NockmaIdeCommand
+  = NockmaIdeHighlight NockmaHighlightOptions
+  | NockmaIdeCheck NockmaCheckOptions
+  | NockmaIdeRules
+  deriving stock (Data)
+
+parseNockmaIdeCommand :: Parser NockmaIdeCommand
+parseNockmaIdeCommand =
+  hsubparser $
+    mconcat
+      [ commandHighlight,
+        commandCheck,
+        commandRules
+      ]
+  where
+    commandHighlight :: Mod CommandFields NockmaIdeCommand
+    commandHighlight = command "highlight" runInfo
+      where
+        runInfo :: ParserInfo NockmaIdeCommand
+        runInfo =
+          info
+            (NockmaIdeHighlight <$> parseNockmaHighlightOptions)
+            (progDesc "Highlight a nockma term (only for Emacs)")
+
+    commandRules :: Mod CommandFields NockmaIdeCommand
+    commandRules = command "rules" runInfo
+      where
+        runInfo :: ParserInfo NockmaIdeCommand
+        runInfo =
+          info
+            (pure NockmaIdeRules)
+            (progDesc "Print the nockma evaluation rules")
+
+    commandCheck :: Mod CommandFields NockmaIdeCommand
+    commandCheck = command "check" runInfo
+      where
+        runInfo :: ParserInfo NockmaIdeCommand
+        runInfo =
+          info
+            (NockmaIdeCheck <$> parseNockmaCheckOptions)
+            (progDesc "Parse a nockma term")

app/Commands/Dev/Nockma/Ide/Rules.hs

@@ -0,0 +1,12 @@
+module Commands.Dev.Nockma.Ide.Rules where
+
+import Commands.Base
+import Juvix.Compiler.Nockma.Highlight.Doc
+import Juvix.Emacs.Render
+import Juvix.Emacs.SExp
+
+runCommand :: forall r. (Members AppEffects r) => Sem r ()
+runCommand = do
+  let (txt, format) = renderEmacs allRules
+      ret = Pair (String txt) format
+  renderStdOutLn (toPlainText ret)

app/Commands/Dev/Nockma/Options.hs

@@ -3,6 +3,7 @@ module Commands.Dev.Nockma.Options where
 import Commands.Dev.Nockma.Encode.Options
 import Commands.Dev.Nockma.Eval.Options
 import Commands.Dev.Nockma.Format.Options
+import Commands.Dev.Nockma.Ide.Options
 import Commands.Dev.Nockma.Repl.Options
 import Commands.Dev.Nockma.Run.Options
 import CommonOptions
@@ -13,6 +14,7 @@ data NockmaCommand
   | NockmaFormat NockmaFormatOptions
   | NockmaRun NockmaRunOptions
   | NockmaEncode NockmaEncodeOptions
+  | NockmaIde NockmaIdeCommand
   deriving stock (Data)
 
 parseNockmaCommand :: Parser NockmaCommand
@@ -23,9 +25,19 @@ parseNockmaCommand =
         commandFromAsm,
         commandFormat,
         commandEncode,
+        commandIde,
         commandRun
       ]
   where
+    commandIde :: Mod CommandFields NockmaCommand
+    commandIde = command "ide" runInfo
+      where
+        runInfo :: ParserInfo NockmaCommand
+        runInfo =
+          info
+            (NockmaIde <$> parseNockmaIdeCommand)
+            (progDesc "Ide related subcommands")
+
     commandEncode :: Mod CommandFields NockmaCommand
     commandEncode = command "encode" runInfo
       where

app/Commands/Dev/Nockma/Repl.hs

@@ -4,7 +4,6 @@ import Commands.Base hiding (Atom)
 import Commands.Dev.Nockma.Repl.Options
 import Control.Exception (throwIO)
 import Control.Monad.State.Strict qualified as State
-import Data.String.Interpolate (__i)
 import Juvix.Compiler.Nockma.Evaluator (NockEvalError, evalRepl, fromReplTerm, programAssignments)
 import Juvix.Compiler.Nockma.Evaluator.Options
 import Juvix.Compiler.Nockma.Language

app/Commands/Dev/Tree/Repl.hs

@@ -4,7 +4,6 @@ import Commands.Base hiding (Atom)
 import Commands.Dev.Tree.Repl.Options
 import Control.Exception (throwIO)
 import Control.Monad.State.Strict qualified as State
-import Data.String.Interpolate (__i)
 import Juvix.Compiler.Tree.Data.InfoTable
 import Juvix.Compiler.Tree.Data.InfoTableBuilder qualified as Tree
 import Juvix.Compiler.Tree.Language

app/Commands/Repl.hs

@@ -11,7 +11,7 @@ import Control.Monad.Reader qualified as Reader
 import Control.Monad.State.Strict qualified as State
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Reader (mapReaderT)
-import Data.String.Interpolate (i, __i)
+import Data.String.Interpolate (i)
 import HaskelineJB
 import Juvix.Compiler.Concrete.Data.Scope (scopePath)
 import Juvix.Compiler.Concrete.Data.Scope qualified as Scoped

src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs

@@ -324,6 +324,7 @@ putTag ann x = case ann of
   AnnKeyword -> return (Html.span ! juClass JuKeyword $ x)
   AnnUnkindedSym -> return (Html.span ! juClass JuVar $ x)
   AnnComment -> return (Html.span ! juClass JuComment $ x)
+  AnnPragma -> return (Html.span ! juClass JuComment $ x)
   AnnJudoc -> return (Html.span ! juClass JuJudoc $ x)
   AnnDelimiter -> return (Html.span ! juClass JuDelimiter $ x)
   AnnDef r -> boldDefine <*> tagDef r

src/Juvix/Compiler/Backend/Latex/Translation/FromScoped/Source.hs

@@ -108,6 +108,7 @@ putTag ann x = case ann of
   AnnComment -> juColor JuComment x
   AnnJudoc -> juColor JuJudoc x
   AnnDelimiter -> juColor JuDelimiter x
+  AnnPragma -> juColor JuComment x
   AnnDef {} -> x
   AnnRef {} -> x
   AnnCode -> x

src/Juvix/Compiler/Concrete/Data.hs

@@ -8,7 +8,6 @@ module Juvix.Compiler.Concrete.Data
     module Juvix.Compiler.Store.Scoped.Data.InfoTable,
     module Juvix.Compiler.Concrete.Data.InfoTableBuilder,
     module Juvix.Data.NameKind,
-    module Juvix.Compiler.Concrete.Data.ParsedItem,
     module Juvix.Compiler.Concrete.Data.VisibilityAnn,
     module Juvix.Compiler.Concrete.Data.Literal,
     module Juvix.Compiler.Concrete.Data.NameRef,
@@ -27,7 +26,6 @@ import Juvix.Compiler.Concrete.Data.LocalModuleOrigin
 import Juvix.Compiler.Concrete.Data.ModuleIsTop
 import Juvix.Compiler.Concrete.Data.Name
 import Juvix.Compiler.Concrete.Data.NameRef
-import Juvix.Compiler.Concrete.Data.ParsedItem
 import Juvix.Compiler.Concrete.Data.PublicAnn
 import Juvix.Compiler.Concrete.Data.ScopedName qualified
 import Juvix.Compiler.Concrete.Data.VisibilityAnn

src/Juvix/Compiler/Concrete/Data/Highlight.hs

@@ -1,7 +1,7 @@
 module Juvix.Compiler.Concrete.Data.Highlight
   ( module Juvix.Compiler.Concrete.Data.Highlight,
     module Juvix.Compiler.Concrete.Data.Highlight.Builder,
-    module Juvix.Compiler.Concrete.Data.Highlight.Properties,
+    module Juvix.Emacs.Properties,
   )
 where
 
@@ -10,14 +10,14 @@ import Data.ByteString.Lazy qualified as ByteString
 import Data.Text.Encoding qualified as Text
 import Juvix.Compiler.Concrete.Data.Highlight.Builder
 import Juvix.Compiler.Concrete.Data.Highlight.PrettyJudoc
-import Juvix.Compiler.Concrete.Data.Highlight.Properties
-import Juvix.Compiler.Concrete.Data.Highlight.RenderEmacs
 import Juvix.Compiler.Concrete.Data.ScopedName
 import Juvix.Compiler.Internal.Language qualified as Internal
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context qualified as Internal
 import Juvix.Compiler.Store.Scoped.Data.InfoTable qualified as Scoped
 import Juvix.Data.CodeAnn
-import Juvix.Data.Emacs
+import Juvix.Emacs.Properties
+import Juvix.Emacs.Render
+import Juvix.Emacs.SExp
 import Juvix.Prelude as Prelude hiding (show)
 import Prelude qualified
 
@@ -44,12 +44,31 @@ buildProperties HighlightInput {..} =
           <> mapMaybe goFaceName _highlightNames
           <> map goFaceError _highlightErrors,
       _propertiesGoto = map goGotoProperty _highlightNames,
-      _propertiesDoc = mapMaybe (goDocProperty _highlightDocTable _highlightTypes) _highlightNames
+      _propertiesInfo = mapMaybe (goDocProperty _highlightDocTable _highlightTypes) _highlightNames
     }
 
 goFaceError :: Interval -> WithLoc PropertyFace
 goFaceError i = WithLoc i (PropertyFace FaceError)
 
+goFaceSemanticItem :: SemanticItem -> Maybe (WithLoc PropertyFace)
+goFaceSemanticItem i = WithLoc (getLoc i) . PropertyFace <$> f
+  where
+    f :: Maybe Face
+    f = case i ^. withLocParam of
+      AnnKind k -> nameKindFace k
+      AnnKeyword -> Just FaceKeyword
+      AnnComment -> Just FaceComment
+      AnnPragma -> Just FacePragma
+      AnnJudoc -> Just FaceJudoc
+      AnnDelimiter -> Just FaceDelimiter
+      AnnLiteralString -> Just FaceString
+      AnnLiteralInteger -> Just FaceNumber
+      AnnCode -> Nothing
+      AnnImportant -> Nothing
+      AnnUnkindedSym -> Nothing
+      AnnDef {} -> Nothing
+      AnnRef {} -> Nothing
+
 goFaceParsedItem :: ParsedItem -> WithLoc PropertyFace
 goFaceParsedItem i = WithLoc (i ^. parsedLoc) (PropertyFace f)
   where
@@ -73,9 +92,10 @@ goGotoProperty n = WithLoc (getLoc n) PropertyGoto {..}
     _gotoPos = n ^. anameDefinedLoc . intervalStart
     _gotoFile = n ^. anameDefinedLoc . intervalFile
 
-goDocProperty :: Scoped.DocTable -> Internal.TypesTable -> AName -> Maybe (WithLoc PropertyDoc)
+goDocProperty :: Scoped.DocTable -> Internal.TypesTable -> AName -> Maybe (WithLoc PropertyInfo)
 goDocProperty doctbl tbl a = do
   let ty :: Maybe Internal.Expression = tbl ^. Internal.typesTable . at (a ^. anameDocId)
   d <- ppDocDefault a ty (doctbl ^. at (a ^. anameDocId))
-  let (_docText, _docSExp) = renderEmacs (layoutPretty defaultLayoutOptions d)
-  return (WithLoc (getLoc a) PropertyDoc {..})
+  let (txt, _infoInit) = renderEmacs d
+      _infoInfo = String txt
+  return (WithLoc (getLoc a) PropertyInfo {..})

src/Juvix/Compiler/Concrete/Data/Highlight/Builder.hs

@@ -1,13 +1,11 @@
 module Juvix.Compiler.Concrete.Data.Highlight.Builder
   ( module Juvix.Compiler.Concrete.Data.Highlight.Input,
-    module Juvix.Compiler.Concrete.Data.ParsedItem,
     module Juvix.Compiler.Concrete.Data.Highlight.Builder,
   )
 where
 
 import Data.HashMap.Strict qualified as HashMap
 import Juvix.Compiler.Concrete.Data.Highlight.Input
-import Juvix.Compiler.Concrete.Data.ParsedItem
 import Juvix.Compiler.Concrete.Data.ScopedName
 import Juvix.Compiler.Concrete.Language.Base
 import Juvix.Compiler.Internal.Language qualified as Internal

src/Juvix/Compiler/Concrete/Data/Highlight/Input.hs

@@ -1,10 +1,5 @@
-module Juvix.Compiler.Concrete.Data.Highlight.Input
-  ( module Juvix.Compiler.Concrete.Data.Highlight.Input,
-    module Juvix.Compiler.Concrete.Data.ParsedItem,
-  )
-where
+module Juvix.Compiler.Concrete.Data.Highlight.Input where
 
-import Juvix.Compiler.Concrete.Data.ParsedItem
 import Juvix.Compiler.Concrete.Data.ScopedName
 import Juvix.Compiler.Concrete.Language.Base
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context qualified as Internal

src/Juvix/Compiler/Concrete/Gen.hs

@@ -119,8 +119,8 @@ literalInteger a = do
 mkList :: (Member (Reader Interval) r) => [NonEmpty (ExpressionAtom 'Parsed)] -> Sem r (ExpressionAtom 'Parsed)
 mkList as = do
   items <- mapM expressionAtoms' as
-  parenR <- Irrelevant <$> kw kwBracketR
-  parenL <- Irrelevant <$> kw kwBracketL
+  parenR <- Irrelevant <$> kw delimBracketR
+  parenL <- Irrelevant <$> kw delimBracketL
   return
     ( AtomList
         List