content: {-# 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
  