summaryrefslogtreecommitdiff
path: root/src/compiler/GF/System
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2014-10-28 19:04:48 +0000
committerhallgren <hallgren@chalmers.se>2014-10-28 19:04:48 +0000
commit0519493ca936c8e555cfdf9178195418e342ff05 (patch)
tree6f9a8e31b43266591c160a945fd134c8f60b9bb3 /src/compiler/GF/System
parente41d9e34bbb93a594b09fa390140149897a9112f (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')
-rw-r--r--src/compiler/GF/System/Console.hs27
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