From 0519493ca936c8e555cfdf9178195418e342ff05 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Tue, 28 Oct 2014 19:04:48 +0000
Subject: 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.
---
 src/compiler/GF/System/Console.hs | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

(limited to 'src/compiler/GF/System')

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
-- 
cgit v1.2.3