Add --vscode option (#3162)

* Add a `--vscode` option which causes the error messages to be printed
without newlines, in a way compatible with the problem matcher of the
VSCode extension
* Related VSCode extension PR:
https://github.com/anoma/vscode-juvix/pull/153

app/App.hs

@@ -144,7 +144,13 @@ reAppIO args@RunAppIOArgs {..} =
         . mkAnsiText
         . run
         . runReader (project' @GenericOptions g)
-        $ Error.render (not (_runAppIOArgsGlobalOptions ^. globalNoColors)) (g ^. globalIdeEndErrorChar) e
+        $ Error.render renderType (g ^. globalIdeEndErrorChar) e
+      where
+        renderType :: Error.RenderType
+        renderType
+          | g ^. globalVSCode = Error.RenderVSCode
+          | g ^. globalNoColors = Error.RenderText
+          | otherwise = Error.RenderAnsi
 
 getEntryPoint' ::
   (Members '[App, EmbedIO, TaggedLock] r) =>

app/Commands/Repl.hs

@@ -427,7 +427,13 @@ catchAll = Repline.dontCrash . catchJuvixError
             . hPutStrLn stderr
             . run
             . runReader (project' @GenericOptions opts)
-            $ Error.render (not (opts ^. globalNoColors) && hasAnsi) Nothing e
+            $ Error.render (renderType opts hasAnsi) Nothing e
+          where
+            renderType :: GlobalOptions -> Bool -> Error.RenderType
+            renderType opts hasAnsi
+              | opts ^. globalVSCode = Error.RenderVSCode
+              | opts ^. globalNoColors || not hasAnsi = Error.RenderText
+              | otherwise = Error.RenderAnsi
 
         catchErrorS :: ReplS () -> ReplS ()
         catchErrorS = (`Except.catchError` printErrorS)

app/GlobalOptions.hs

@@ -15,6 +15,7 @@ import Juvix.Data.Field
 
 data GlobalOptions = GlobalOptions
   { _globalNoColors :: Bool,
+    _globalVSCode :: Bool,
     _globalShowNameIds :: Bool,
     _globalBuildDir :: Maybe (AppPath Dir),
     _globalIdeEndErrorChar :: Maybe Char,
@@ -60,6 +61,7 @@ defaultGlobalOptions :: GlobalOptions
 defaultGlobalOptions =
   GlobalOptions
     { _globalNoColors = False,
+      _globalVSCode = False,
       _globalNumThreads = defaultNumThreads,
       _globalShowNameIds = False,
       _globalIdeEndErrorChar = Nothing,
@@ -85,6 +87,11 @@ parseGlobalFlags = do
       ( long "no-colors"
           <> help "Disable ANSI formatting"
       )
+  _globalVSCode <-
+    switch
+      ( long "vscode"
+          <> help "Enable VSCode compatible output"
+      )
   _globalBuildDir <-
     optional
       ( parseBuildDir

src/Juvix/Data/Error/GenericError.hs

@@ -3,12 +3,18 @@ module Juvix.Data.Error.GenericError
   )
 where
 
+import Data.Text qualified as Text
 import Juvix.Data.Loc
 import Juvix.Prelude.Base
 import Juvix.Prelude.Pretty
 import Prettyprinter.Render.Terminal qualified as Ansi
 import System.Console.ANSI qualified as Ansi
 
+data RenderType
+  = RenderAnsi
+  | RenderText
+  | RenderVSCode
+
 data GenericError = GenericError
   { _genericErrorLoc :: Interval,
     _genericErrorMessage :: AnsiText,
@@ -68,29 +74,31 @@ errorIntervals e = do
   e' <- genericError e
   return (e' ^. genericErrorIntervals)
 
-render :: (ToGenericError e, Member (Reader GenericOptions) r) => Bool -> Maybe Char -> e -> Sem r Text
-render ansi endChar err = do
+render :: (ToGenericError e, Member (Reader GenericOptions) r) => RenderType -> Maybe Char -> e -> Sem r Text
+render renderType endChar err = do
   g <- genericError err
   let gMsg = g ^. genericErrorMessage
       header = genericErrorHeader g
-      helper f x = (f . layoutPretty defaultLayoutOptions) (header <> x <> lastChar)
-  if
-      | ansi -> return $ helper Ansi.renderStrict (toAnsiDoc gMsg)
-      | otherwise -> return $ helper renderStrict (toTextDoc gMsg)
+      helper f x = f (header <> x <> lastChar)
+  return $
+    case renderType of
+      RenderAnsi -> helper (Ansi.renderStrict . layoutPretty defaultLayoutOptions) (toAnsiDoc gMsg)
+      RenderText -> helper (renderStrict . layoutPretty defaultLayoutOptions) (toTextDoc gMsg)
+      RenderVSCode -> Text.replace "\n" " " $ helper (renderStrict . layoutCompact) (toTextDoc gMsg)
   where
     lastChar :: Doc a
     lastChar = maybe "" pretty endChar
 
 -- | Render the error to Text.
 renderText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text
-renderText = render False Nothing
+renderText = render RenderText Nothing
 
 renderTextDefault :: (ToGenericError e) => e -> Text
 renderTextDefault = run . runReader defaultGenericOptions . renderText
 
 -- | Render the error with Ansi formatting (if any).
 renderAnsiText :: (ToGenericError e, Member (Reader GenericOptions) r) => e -> Sem r Text
-renderAnsiText = render True Nothing
+renderAnsiText = render RenderAnsi Nothing
 
 printErrorAnsi :: (ToGenericError e, Members '[EmbedIO, Reader GenericOptions] r) => e -> Sem r ()
 printErrorAnsi e = renderAnsiText e >>= \txt -> hPutStrLn stderr txt