b8d7935 · Idris-dev · git.iko.soy

src/Idris/AbsSyntax.hs+11−1

compare with master

unifiedsplit

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

511 let opt' = opts { opt_repl = t }

512 putIState $ i { idris_options = opt' }

513

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+

514setNoBanner :: Bool -> Idris ()

524setNoBanner :: Bool -> Idris ()

515setNoBanner n = do i <- getIState

525setNoBanner n = do i <- getIState

516 let opts = idris_options i

526 let opts = idris_options i

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

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

518 putIState $ i { idris_options = opt' }

528 putIState $ i { idris_options = opt' }

519

529

520getNoBanner :: Idris Bool

530getNoBanner :: Idris Bool

src/Idris/AbsSyntaxTree.hs+4−1

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

49 opt_triple :: String,

50 opt_cpu :: String,

51 opt_optLevel :: Word,

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

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

53+ opt_origerr :: Bool

53 }

54 }

54 deriving (Show, Eq)

55 deriving (Show, Eq)

55

56

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

71 , opt_cpu = ""

72 , opt_cpu = ""

72 , opt_optLevel = 2

73 , opt_optLevel = 2

73 , opt_cmdline = []

74 , opt_cmdline = []

75+ , opt_origerr = False

74 }

76 }

75

77

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

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

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

314 | TargetCPU String

316 | TargetCPU String

315 | OptLevel Word

317 | OptLevel Word

316 | Client String

318 | Client String

319+ | ShowOrigErr

317 deriving (Show, Eq)

320 deriving (Show, Eq)

318

321

319-- Parsed declarations

322-- Parsed declarations

src/Idris/Completion.hs+1−1

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

104

105completeOption :: CompletionFunc Idris

106completeOption = completeWord Nothing " \t" completeOpt

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

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

108

109isWhitespace :: Char -> Bool

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

src/Idris/Delaborate.hs+3−1

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

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

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

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

202+ if (opt_origerr (idris_options i))

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

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

204+ else ""

203 where showPart :: ErrorReportPart -> String

205 where showPart :: ErrorReportPart -> String

204 showPart (TextPart str) = str

206 showPart (TextPart str) = str

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

207 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)

312 iPrintResult ""

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

314 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 ""

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

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

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

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

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

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

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

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

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

909process h fn NOP = return ()

913process h fn NOP = return ()

910

914

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

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

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

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

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

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

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

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

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

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

915

921

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

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

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

923process 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)

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

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

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

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

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

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

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

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

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

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

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

105pOption :: P.IdrisParser Opt

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

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

108−

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

109

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

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