b8d7935 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Hide original errors upon reflective rewrite

Original error messages are now hidden by default. They can be enabled with :set originalerrors at the REPL.

commitb8d793568d36108e0be44fab498ee9a181b2661a authorDavid Raymond Christiansen <david@davidchristiansen.dk> dateFri 24 Jan 2014, 18:42 (13 years ago) parentb4943a2

6 files changed+32−11

compare with master

unifiedsplit

src/Idris/AbsSyntax.hs+11−1 src/Idris/AbsSyntaxTree.hs+4−1 src/Idris/Completion.hs+1−1 src/Idris/Delaborate.hs+3−1 src/Idris/REPL.hs+10−4 src/Idris/REPLParser.hs+3−3

src/Idris/AbsSyntax.hs+11−1

@@ -511,10 +511,20 @@ setREPL t = do i <- getIState

511511 let opt' = opts { opt_repl = t }

512512 putIState $ i { idris_options = opt' }

513513

514+showOrigErr :: Idris Bool

515+showOrigErr = do i <- getIState

516+ return (opt_origerr (idris_options i))

517+

518+setShowOrigErr :: Bool -> Idris ()

519+setShowOrigErr b = do i <- getIState

520+ let opts = idris_options i

521+ let opt' = opts { opt_origerr = b }

522+ putIState $ i { idris_options = opt' }

523+

514524setNoBanner :: Bool -> Idris ()

515525setNoBanner n = do i <- getIState

516526 let opts = idris_options i

517− let opt' = opts {opt_nobanner = n}

527+ let opt' = opts { opt_nobanner = n }

518528 putIState $ i { idris_options = opt' }

519529

520530getNoBanner :: Idris Bool

src/Idris/AbsSyntaxTree.hs+4−1

@@ -49,7 +49,8 @@ data IOption = IOption { opt_logLevel :: Int,

4949 opt_triple :: String,

5050 opt_cpu :: String,

5151 opt_optLevel :: Word,

52− opt_cmdline :: [Opt] -- remember whole command line

52+ opt_cmdline :: [Opt], -- remember whole command line

53+ opt_origerr :: Bool

5354 }

5455 deriving (Show, Eq)

5556

@@ -71,6 +72,7 @@ defaultOpts = IOption { opt_logLevel = 0

7172 , opt_cpu = ""

7273 , opt_optLevel = 2

7374 , opt_cmdline = []

75+ , opt_origerr = False

7476 }

7577

7678data LanguageExt = TypeProviders | ErrorReflection deriving (Show, Eq, Read, Ord)

@@ -314,6 +316,7 @@ data Opt = Filename String

314316 | TargetCPU String

315317 | OptLevel Word

316318 | Client String

319+ | ShowOrigErr

317320 deriving (Show, Eq)

318321

319322-- Parsed declarations

src/Idris/Completion.hs+1−1

@@ -104,7 +104,7 @@ completeMetaVar = completeWord Nothing (" \t(){}:" ++ opChars) completeM

104104

105105completeOption :: CompletionFunc Idris

106106completeOption = completeWord Nothing " \t" completeOpt

107− where completeOpt = return . (completeWith ["errorcontext", "showimplicits"])

107+ where completeOpt = return . completeWith ["errorcontext", "showimplicits", "originalerrors"]

108108

109109isWhitespace :: Char -> Bool

110110isWhitespace = (flip elem) " \t\n"

src/Idris/Delaborate.hs+3−1

@@ -199,7 +199,9 @@ pshow i (ProviderError msg) = "Type provider error: " ++ msg

199199pshow i (LoadingFailed fn e) = "Loading " ++ fn ++ " failed: " ++ pshow i e

200200pshow i (ReflectionError parts orig) = let parts' = map (concat . intersperse " " . map showPart) parts in

201201 concat (intersperse "\n" parts') ++

202− "\nOriginal error:\n" ++ indented (pshow i orig)

202+ if (opt_origerr (idris_options i))

203+ then "\nOriginal error:\n" ++ indented (pshow i orig)

204+ else ""

203205 where showPart :: ErrorReportPart -> String

204206 showPart (TextPart str) = str

205207 showPart (NamePart n) = let colour = idris_colourRepl i in

src/Idris/REPL.hs+10−4

@@ -312,6 +312,10 @@ ideslaveProcess fn (SetOpt ShowImpl) = do process stdout fn (SetOpt ShowImpl)

312312 iPrintResult ""

313313ideslaveProcess fn (UnsetOpt ShowImpl) = do process stdout fn (UnsetOpt ShowImpl)

314314 iPrintResult ""

315+ideslaveProcess fn (SetOpt ShowOrigErr) = do process stdout fn (SetOpt ShowOrigErr)

316+ iPrintResult ""

317+ideslaveProcess fn (UnsetOpt ShowOrigErr) = do process stdout fn (UnsetOpt ShowOrigErr)

318+ iPrintResult ""

315319ideslaveProcess fn (SetOpt x) = process stdout fn (SetOpt x)

316320ideslaveProcess fn (UnsetOpt x) = process stdout fn (UnsetOpt x)

317321ideslaveProcess fn (CaseSplitAt False pos str) = process stdout fn (CaseSplitAt False pos str)

@@ -908,10 +912,12 @@ process h fn Metavars

908912 _ -> iPrintResult $ "Global metavariables:\n\t" ++ show mvs

909913process h fn NOP = return ()

910914

911−process h fn (SetOpt ErrContext) = setErrContext True

912−process h fn (UnsetOpt ErrContext) = setErrContext False

913−process h fn (SetOpt ShowImpl) = setImpShow True

914−process h fn (UnsetOpt ShowImpl) = setImpShow False

915+process h fn (SetOpt ErrContext) = setErrContext True

916+process h fn (UnsetOpt ErrContext) = setErrContext False

917+process h fn (SetOpt ShowImpl) = setImpShow True

918+process h fn (UnsetOpt ShowImpl) = setImpShow False

919+process h fn (SetOpt ShowOrigErr) = setShowOrigErr True

920+process h fn (UnsetOpt ShowOrigErr) = setShowOrigErr False

915921

916922process h fn (SetOpt _) = iPrintError "Not a valid option"

917923process h fn (UnsetOpt _) = iPrintError "Not a valid option"

src/Idris/REPLParser.hs+3−3

@@ -61,8 +61,8 @@ pCmd = do P.whiteSpace; try (do cmd ["q", "quit"]; eof; return Quit)

6161 <|> try (do cmd ["dynamic"]; eof; return ListDynamic)

6262 <|> try (do cmd ["dynamic"]; l <- many anyChar; return (DynamicLink l))

6363 <|> try (do cmd ["color", "colour"]; pSetColourCmd)

64− <|> try (do cmd ["set"]; o <-pOption; return (SetOpt o))

65− <|> try (do cmd ["unset"]; o <-pOption; return (UnsetOpt o))

64+ <|> try (do cmd ["set"]; o <- pOption; return (SetOpt o))

65+ <|> try (do cmd ["unset"]; o <- pOption; return (UnsetOpt o))

6666 <|> try (do cmd ["s", "search"]; P.whiteSpace; t <- P.fullExpr defaultSyntax; return (Search t))

6767 <|> try (do cmd ["cs", "casesplit"]; P.whiteSpace;

6868 upd <- option False (do P.lchar '!'; return True)

@@ -105,7 +105,7 @@ pCmd = do P.whiteSpace; try (do cmd ["q", "quit"]; eof; return Quit)

105105pOption :: P.IdrisParser Opt

106106pOption = do discard (P.symbol "errorcontext"); return ErrContext

107107 <|> do discard (P.symbol "showimplicits"); return ShowImpl

108−

108+ <|> do discard (P.symbol "originalerrors"); return ShowOrigErr

109109

110110colours :: [(String, Maybe Color)]

111111colours = [ ("black", Just Black)