c0342c7 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add command line option to control REPL colours

--colour will ensure that colours are on, and --nocolour will ensure that they are off. American spellings also supported.

commitc0342c730bde00b274e78581dcec5e9cbc73b318 authorDavid Christiansen <david@davidchristiansen.dk> dateWed 4 Sep 2013, 16:29 (13 years ago) parent6c14565

4 files changed+39−13

compare with master

unifiedsplit

src/Idris/AbsSyntax.hs+4 src/Idris/AbsSyntaxTree.hs+6−3 src/Idris/REPL.hs+28−10 src/Main.hs+1

src/Idris/AbsSyntax.hs+4

@@ -481,6 +481,10 @@ allImportDirs :: IState -> Idris [FilePath]

481481allImportDirs i = do let optdirs = opt_importdirs (idris_options i)

482482 return ("." : reverse optdirs)

483483

484+colourise :: Idris Bool

485+colourise = do i <- getIState

486+ return $ idris_colourRepl i

487+

484488impShow :: Idris Bool

485489impShow = do i <- getIState

486490 return (opt_showimp (idris_options i))

src/Idris/AbsSyntaxTree.hs+6−3

@@ -120,7 +120,8 @@ data IState = IState {

120120 compiled_so :: Maybe String,

121121 idris_dynamic_libs :: [DynamicLib],

122122 idris_language_extensions :: [LanguageExt],

123− idris_outputmode :: OutputMode

123+ idris_outputmode :: OutputMode,

124+ idris_colourRepl :: Bool

124125 }

125126

126127data SizeChange = Smaller | Same | Bigger | Unknown

@@ -177,6 +178,7 @@ idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext

177178 emptyContext emptyContext emptyContext emptyContext

178179 [] "" defaultOpts 6 [] [] [] [] [] [] [] [] [] []

179180 [] Nothing Nothing [] [] [] Hidden False [] Nothing [] [] RawOutput

181+ True

180182

181183-- | The monad for the main REPL - reading and processing files and updating

182184-- global state (hence the IO inner monad).

@@ -235,6 +237,7 @@ data Opt = Filename String

235237 | Ver

236238 | Usage

237239 | Quiet

240+ | ColourREPL Bool

238241 | Ideslave

239242 | ShowLibs

240243 | ShowLibdir

@@ -248,8 +251,8 @@ data Opt = Filename String

248251 | DefaultTotal

249252 | DefaultPartial

250253 | WarnPartial

251− | NoCoverage

252− | ErrContext

254+ | NoCoverage

255+ | ErrContext

253256 | ShowImpl

254257 | Verbose

255258 | IBCSubDir String

src/Idris/REPL.hs+28−10

@@ -304,8 +304,9 @@ process fn (Eval t)

304304 logLvl 3 $ "Raw: " ++ show (tm', ty')

305305 logLvl 10 $ "Debug: " ++ showEnvDbg [] tm'

306306 imp <- impShow

307− iResult (showImp (Just ist) imp True (delab ist tm') ++ " : " ++

308− showImp (Just ist) imp True (delab ist ty'))

307+ c <- colourise

308+ iResult (showImp (Just ist) imp c (delab ist tm') ++ " : " ++

309+ showImp (Just ist) imp c (delab ist ty'))

309310process fn (ExecVal t)

310311 = do ctxt <- getContext

311312 ist <- getIState

@@ -314,15 +315,17 @@ process fn (ExecVal t)

314315 let ty' = normaliseAll ctxt [] ty

315316 res <- execute tm

316317 imp <- impShow

317− iResult (showImp (Just ist) imp True (delab ist res) ++ " : " ++

318− showImp (Just ist) imp True (delab ist ty'))

318+ c <- colourise

319+ iResult (showImp (Just ist) imp c (delab ist res) ++ " : " ++

320+ showImp (Just ist) imp c (delab ist ty'))

319321process fn (Check (PRef _ n))

320322 = do ctxt <- getContext

321323 ist <- getIState

322324 imp <- impShow

325+ c <- colourise

323326 case lookupNames n ctxt of

324327 ts@(_:_) -> do mapM_ (\n -> iputStrLn $ show n ++ " : " ++

325− showImp (Just ist) imp True (delabTy ist n)) ts

328+ showImp (Just ist) imp c (delabTy ist n)) ts

326329 iResult ""

327330 [] -> iFail $ "No such variable " ++ show n

328331process fn (Check t)

@@ -330,11 +333,12 @@ process fn (Check t)

330333 ctxt <- getContext

331334 ist <- getIState

332335 imp <- impShow

336+ c <- colourise

333337 let ty' = normaliseC ctxt [] ty

334338 case tm of

335339 TType _ -> iResult ("Type : Type 1")

336− _ -> iResult (showImp (Just ist) imp True (delab ist tm) ++ " : " ++

337− showImp (Just ist) imp True (delab ist ty))

340+ _ -> iResult (showImp (Just ist) imp c (delab ist tm) ++ " : " ++

341+ showImp (Just ist) imp c (delab ist ty))

338342

339343process fn (DocStr n) = do i <- getIState

340344 case lookupCtxtName n (idris_docstrings i) of

@@ -364,8 +368,9 @@ process fn (Defn n) = do i <- getIState

364368 [t] -> iputStrLn (showTotal t i)

365369 _ -> return ()

366370 where printCase i (_, lhs, rhs)

367− = do iputStrLn (showImp (Just i) True False (delab i lhs) ++ " = " ++

368− showImp (Just i) True False (delab i rhs))

371+ = do c <- colourise

372+ iputStrLn (showImp (Just i) True c (delab i lhs) ++ " = " ++

373+ showImp (Just i) True c (delab i rhs))

369374process fn (TotCheck n) = do i <- getIState

370375 case lookupTotal n (tt_ctxt i) of

371376 [t] -> iResult (showTotal t i)

@@ -502,10 +507,11 @@ process fn (Pattelab t)

502507

503508process fn (Missing n)

504509 = do i <- getIState

510+ c <- colourise

505511 case lookupCtxt n (idris_patdefs i) of

506512 [] -> return ()

507513 [(_, tms)] ->

508− iResult (showSep "\n" (map (showImp (Just i) True False) tms))

514+ iResult (showSep "\n" (map (showImp (Just i) True c) tms))

509515 _ -> iFail $ "Ambiguous name"

510516process fn (DynamicLink l) = do i <- getIState

511517 let lib = trim l

@@ -627,6 +633,10 @@ parseArgs ("-O0":ns) = OptLevel 0 : parseArgs ns

627633parseArgs ("-O":n:ns) = OptLevel (read n) : parseArgs ns

628634parseArgs ("--target":n:ns) = TargetTriple n : parseArgs ns

629635parseArgs ("--cpu":n:ns) = TargetCPU n : parseArgs ns

636+parseArgs ("--colour":ns) = ColourREPL True : parseArgs ns

637+parseArgs ("--color":ns) = ColourREPL True : parseArgs ns

638+parseArgs ("--nocolour":ns) = ColourREPL False : parseArgs ns

639+parseArgs ("--nocolor":ns) = ColourREPL False : parseArgs ns

630640parseArgs (n:ns) = Filename n : (parseArgs ns)

631641

632642helphead =

@@ -740,6 +750,10 @@ idrisMain opts =

740750 [expr] -> return (Just expr)

741751 when (DefaultTotal `elem` opts) $ do i <- getIState

742752 putIState (i { default_total = True })

753+ case opt getColour opts of

754+ [] -> return ()

755+ xs -> do i <- getIState

756+ putIState (i { idris_colourRepl = last xs })

743757 mapM_ addLangExt (opt getLanguageExt opts)

744758 setREPL runrepl

745759 setQuiet (quiet || isJust script)

@@ -876,6 +890,10 @@ getOptLevel :: Opt -> Maybe Int

876890getOptLevel (OptLevel x) = Just x

877891getOptLevel _ = Nothing

878892

893+getColour :: Opt -> Maybe Bool

894+getColour (ColourREPL b) = Just b

895+getColour _ = Nothing

896+

879897opt :: (Opt -> Maybe a) -> [Opt] -> [a]

880898opt = mapMaybe

881899

src/Main.hs+1

@@ -80,6 +80,7 @@ usagemsg = "Idris version " ++ ver ++ "\n" ++

8080 "Usage: idris [input file] [options]\n" ++

8181 "Options:\n" ++

8282 "\t--quiet Quiet mode (for editors)\n" ++

83+ "\t--[no]colour Control REPL colour highlighting" ++

8384 "\t--check Type check only\n" ++

8485 "\t-o [file] Specify output filename\n" ++

8586 "\t-i [dir] Add directory to the list of import paths\n" ++