highlight errors even if real output is to a file

(unless told not to)
This commit is contained in:
rhiannon morris 2023-11-01 14:16:03 +01:00
parent 050346e344
commit 4cc50c6bcd
2 changed files with 10 additions and 8 deletions

View File

@ -30,7 +30,7 @@ die opts err = do
private
runPretty : Options -> Eff Pretty a -> a
runPretty opts act =
let doColor = opts.color && opts.outFile == Stdout
let doColor = opts.color && opts.outFile == Console
hl = if doColor then highlightSGR else noHighlight
in
runPrettyWith Outer opts.flavor hl 2 act
@ -133,9 +133,9 @@ private
outputStr : Lazy String -> Eff Compile ()
outputStr str =
case !(asksAt OPTS outFile) of
None => pure ()
Stdout => putStr str
File f => do
None => pure ()
Console => putStr str
File f => do
res <- withFile f WriteTruncate pure $ \h => fPutStr h str
rethrow $ mapFst (WriteError f) res
@ -221,7 +221,9 @@ main = do
(_, opts, files) <- options
case !(runCompile opts !newState $ traverse_ processFile files) of
Right () => pure ()
Left e => die (Opts opts.width) $ runPretty opts $ prettyError e
Left e => die (Opts opts.width) $
runPretty ({outFile := Console} opts) $
prettyError e
-----------------------------------

View File

@ -11,7 +11,7 @@ import Derive.Prelude
%language ElabReflection
public export
data OutFile = File String | Stdout | None
data OutFile = File String | Console | None
%name OutFile f
%runElab derive "OutFile" [Eq, Ord, Show]
@ -44,7 +44,7 @@ export
defaultOpts : IO Options
defaultOpts = pure $ MkOpts {
color = True,
outFile = Stdout,
outFile = Console,
until = Nothing,
flavor = Unicode,
width = cast !getTermCols,
@ -61,7 +61,7 @@ data OptAction = ShowHelp HelpType | Err String | Ok (Options -> Options)
private
toOutFile : String -> OptAction
toOutFile "" = Ok {outFile := None}
toOutFile "-" = Ok {outFile := Stdout}
toOutFile "-" = Ok {outFile := Console}
toOutFile f = Ok {outFile := File f}
private