diff options
| author | hallgren <hallgren@chalmers.se> | 2014-10-28 19:04:48 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2014-10-28 19:04:48 +0000 |
| commit | 0519493ca936c8e555cfdf9178195418e342ff05 (patch) | |
| tree | 6f9a8e31b43266591c160a945fd134c8f60b9bb3 /src/compiler/GF/System/Console.hs | |
| parent | e41d9e34bbb93a594b09fa390140149897a9112f (diff) | |
Use terminfo to highlight warnings and errors in blue and red
This replaces the hardwired ANSI escape codes that were accidentally included
in a previous patch.
This adds a dependency on terminfo, but this should be unproblematic, since
haskeline already depends on the same underlying C library.
The color highlighting is omitted on Windows.
Diffstat (limited to 'src/compiler/GF/System/Console.hs')
| -rw-r--r-- | src/compiler/GF/System/Console.hs | 27 |
1 files changed, 26 insertions, 1 deletions
diff --git a/src/compiler/GF/System/Console.hs b/src/compiler/GF/System/Console.hs index 975b229f1..37eac816d 100644 --- a/src/compiler/GF/System/Console.hs +++ b/src/compiler/GF/System/Console.hs @@ -1,11 +1,18 @@ {-# LANGUAGE CPP #-} module GF.System.Console( -- ** Changing which character encoding to use for console IO - setConsoleEncoding,changeConsoleEncoding) where + setConsoleEncoding,changeConsoleEncoding, + -- ** Console colors + TermColors(..),getTermColors +) where import System.IO +import Control.Monad(guard) +import Control.Monad.Trans(MonadIO(..)) #ifdef mingw32_HOST_OS import System.Win32.Console import System.Win32.NLS +#else +import System.Console.Terminfo #endif -- | Set the console encoding (for Windows, has no effect on Unix-like systems) @@ -43,3 +50,21 @@ readCP code = "UTF-8" -> Just 65001 _ -> Nothing #endif + +data TermColors = TermColors { redFg,blueFg,restore :: String } deriving Show +noTermColors = TermColors "" "" "" + +getTermColors :: MonadIO m => m TermColors +#ifdef mingw32_HOST_OS +getTermColors = return noTermColors +#else +getTermColors = + liftIO $ + do term <- setupTermFromEnv + return $ maybe noTermColors id $ getCapability term $ + do n <- termColors + guard (n>=8) + fg <- setForegroundColor + restore <- restoreDefaultColors + return $ TermColors (fg Red) (fg Blue) restore +#endif |
