Factor out code for setting the console encoding

Moved similar low-level code blocks in Main and GFI for setting the console
encoding to the new module GF.System.Console.

gf.cabal

@@ -54,7 +54,6 @@ library
                  random,
                  pretty,
                  mtl
---ghc-options: -O2
   hs-source-dirs: src/compiler src/runtime/haskell
   extensions: 
   exposed-modules: 
@@ -127,7 +126,6 @@ executable gf
 
   ghc-prof-options: -auto-all
 
---ghc-options: -O2
   if impl(ghc>=7.0)
     ghc-options: -rtsopts
   hs-source-dirs: src/compiler src/runtime/haskell
@@ -148,6 +146,8 @@ executable gf
     GF.Infra.Option
     GF.Infra.UseIO
     GF.Infra.CheckM
+    GF.System.Signal
+    GF.System.Console
     GF.Command.Commands
     GF.Command.Interpreter
     GF.Command.Abstract

src/compiler/GF.hs

@@ -1,4 +1,3 @@
-{-# OPTIONS -cpp #-}
 module Main where
 
 import GFC
@@ -14,22 +13,11 @@ import System.Directory
 import System.Environment (getArgs)
 import System.Exit
 import System.IO
-#ifdef mingw32_HOST_OS
-import System.Win32.Console
-import System.Win32.NLS
-#endif
+import GF.System.Console (setConsoleEncoding)
 
 main :: IO ()
 main = do
-#ifdef mingw32_HOST_OS
-  codepage <- getACP
-  setConsoleCP codepage
-  setConsoleOutputCP codepage
-  enc <- mkTextEncoding ("CP"++show codepage)
-  hSetEncoding stdin  enc
-  hSetEncoding stdout enc
-  hSetEncoding stderr enc
-#endif
+  setConsoleEncoding
   args <- getArgs
   case parseOptions args of
     Ok (opts,files) -> do curr_dir <- getCurrentDirectory

src/compiler/GF/System/Console.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP #-}
+module GF.System.Console(setConsoleEncoding,changeConsoleEncoding) where
+import System.IO
+#ifdef mingw32_HOST_OS
+import System.Win32.Console
+import System.Win32.NLS
+#endif
+
+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

src/compiler/GFI.hs

@@ -50,10 +50,7 @@ import qualified GF.System.Signal as IO(runInterruptibly)
 #ifdef SERVER_MODE
 import GFServer(server)
 #endif
-#ifdef mingw32_HOST_OS
-import System.Win32.Console
-import System.Win32.NLS
-#endif
+import GF.System.Console(changeConsoleEncoding)
 
 import GF.Infra.BuildInfo(buildInfo)
 import Data.Version(showVersion)
@@ -315,21 +312,7 @@ execute1 opts gfenv0 s0 =
 
     set_encoding [c] =
       do let cod = renameEncoding c
-         restricted $ do
-#ifdef mingw32_HOST_OS
-           case cod of
-             'C':'P':c -> case reads c of
-                            [(cp,"")] -> do setConsoleCP cp
-                                            setConsoleOutputCP cp
-                            _         -> return ()
-             "UTF-8"   -> do setConsoleCP 65001
-                             setConsoleOutputCP 65001
-             _         -> return ()
-#endif
-           enc <- mkTextEncoding cod
-           hSetEncoding stdin  enc
-           hSetEncoding stdout enc
-           hSetEncoding stderr enc
+         restricted $ changeConsoleEncoding cod
          continue gfenv
     set_encoding _ = putStrLn "se command not parsed" >> continue gfenv