reintroduce the compiler API

src/compiler/api/GF/System/Console.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE CPP #-}
+module GF.System.Console(
+    -- ** Console IO
+    -- *** Changing which character encoding to use for console IO
+    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)
+setConsoleEncoding =
+#ifdef mingw32_HOST_OS
+    do codepage <- getACP
+       setCP codepage
+       setEncoding ("CP"++show codepage)
+#endif
+       return () :: IO ()
+
+changeConsoleEncoding code =
+    do
+#ifdef mingw32_HOST_OS
+       maybe (return ()) setCP (readCP code)
+#endif
+       setEncoding code
+
+setEncoding code =
+    do enc <- mkTextEncoding code
+       hSetEncoding stdin  enc
+       hSetEncoding stdout enc
+       hSetEncoding stderr enc
+
+#ifdef mingw32_HOST_OS
+setCP codepage =
+    do setConsoleCP codepage
+       setConsoleOutputCP codepage
+
+readCP code =
+       case code of
+         'C':'P':c -> case reads c of
+                        [(cp,"")] -> Just cp
+                        _         -> Nothing
+         "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