Reduce CPP usage as well #4272

Author: snoyberg

package.yaml

@@ -93,7 +93,7 @@ dependencies:
 - project-template
 - regex-applicative-text
 - resourcet
-- retry
+- retry >= 0.7
 - rio
 - semigroups
 - split
@@ -258,6 +258,7 @@ library:
   - Stack.Upgrade
   - Stack.Upload
   - Text.PrettyPrint.Leijen.Extended
+  - System.Permissions
   - System.Process.PagerEditor
   - System.Terminal
   when:

src/Data/Attoparsec/Interpreter.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
 {- |  This module implements parsing of additional arguments embedded in a
       comment when stack is invoked as a script interpreter
 
@@ -145,11 +144,7 @@ getInterpreterArgs file = do
 
     decodeError e =
       case e of
-#if MIN_VERSION_conduit_extra(1,2,0)
         ParseError ctxs _ (Position line col _) ->
-#else
-        ParseError ctxs _ (Position line col) ->
-#endif
           if null ctxs
           then "Parse error"
           else ("Expecting " ++ intercalate " or " ctxs)

src/Network/HTTP/Download/Verified.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DeriveDataTypeable    #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
@@ -192,11 +191,7 @@ hashChecksToZipSink req = traverse_ (ZipSink . sinkCheckHash req)
 -- 'Control.Retry.recovering' customized for HTTP failures
 recoveringHttp :: forall env a. HasRunner env => RetryPolicy -> RIO env a -> RIO env a
 recoveringHttp retryPolicy =
-#if MIN_VERSION_retry(0,7,0)
     helper $ \run -> recovering retryPolicy (handlers run) . const
-#else
-    helper $ \run -> recovering retryPolicy (handlers run)
-#endif
   where
     helper :: (UnliftIO (RIO env) -> IO a -> IO a) -> RIO env a -> RIO env a
     helper wrapper action = withUnliftIO $ \run -> wrapper run (unliftIO run action)

src/Stack/Build.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -46,16 +45,9 @@ import           Stack.Types.Config
 import           Stack.Types.NamedComponent
 import           Stack.Types.Package
 
-import           Stack.Types.Compiler (compilerVersionText
-#ifdef WINDOWS
-                                      ,getGhcVersion
-#endif
-                                      )
+import           Stack.Types.Compiler (compilerVersionText, getGhcVersion)
 import           System.FileLock (FileLock, unlockFile)
-
-#ifdef WINDOWS
-import           System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP)
-#endif
+import           System.Terminal (fixCodePage)
 
 -- | Build.
 --
@@ -67,7 +59,10 @@ build :: HasEnvConfig env
       -> Maybe FileLock
       -> BuildOptsCLI
       -> RIO env ()
-build msetLocalFiles mbuildLk boptsCli = fixCodePage $ do
+build msetLocalFiles mbuildLk boptsCli = do
+  mcp <- view $ configL.to configModifyCodePage
+  ghcVersion <- view $ actualCompilerVersionL.to getGhcVersion
+  fixCodePage mcp ghcVersion $ do
     bopts <- view buildOptsL
     let profiling = boptsLibProfile bopts || boptsExeProfile bopts
     let symbols = not (boptsLibStrip bopts || boptsExeStrip bopts)
@@ -282,53 +277,6 @@ loadPackage loc flags ghcOptions = do
         }
   resolvePackage pkgConfig <$> loadCabalFileImmutable loc
 
--- | Set the code page for this process as necessary. Only applies to Windows.
--- See: https://github.com/commercialhaskell/stack/issues/738
-fixCodePage :: HasEnvConfig env => RIO env a -> RIO env a
-#ifdef WINDOWS
-fixCodePage inner = do
-    mcp <- view $ configL.to configModifyCodePage
-    ghcVersion <- view $ actualCompilerVersionL.to getGhcVersion
-    if mcp && ghcVersion < mkVersion [7, 10, 3]
-        then fixCodePage'
-        -- GHC >=7.10.3 doesn't need this code page hack.
-        else inner
-  where
-    fixCodePage' = do
-        origCPI <- liftIO getConsoleCP
-        origCPO <- liftIO getConsoleOutputCP
-
-        let setInput = origCPI /= expected
-            setOutput = origCPO /= expected
-            fixInput
-                | setInput = bracket_
-                    (liftIO $ do
-                        setConsoleCP expected)
-                    (liftIO $ setConsoleCP origCPI)
-                | otherwise = id
-            fixOutput
-                | setOutput = bracket_
-                    (liftIO $ do
-                        setConsoleOutputCP expected)
-                    (liftIO $ setConsoleOutputCP origCPO)
-                | otherwise = id
-
-        case (setInput, setOutput) of
-            (False, False) -> return ()
-            (True, True) -> warn ""
-            (True, False) -> warn " input"
-            (False, True) -> warn " output"
-
-        fixInput $ fixOutput inner
-    expected = 65001 -- UTF-8
-    warn typ = logInfo $
-        "Setting" <>
-        typ <>
-        " codepage to UTF-8 (65001) to ensure correct output from GHC"
-#else
-fixCodePage = id
-#endif
-
 -- | Query information about the build and print the result to stdout in YAML format.
 queryBuildInfo :: HasEnvConfig env
                => [Text] -- ^ selectors

src/Stack/Build/Cache.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -39,9 +38,7 @@ import qualified Data.ByteArray as Mem (convert)
 import qualified Data.ByteString.Base64.URL as B64URL
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as S8
-#ifdef mingw32_HOST_OS
 import           Data.Char (ord)
-#endif
 import qualified Data.Map as M
 import qualified Data.Set as Set
 import qualified Data.Store as Store
@@ -359,8 +356,9 @@ readPrecompiledCache loc copts depIDs = do
 
 -- | Check if a filesystem path is too long.
 pathTooLong :: FilePath -> Bool
-#ifdef mingw32_HOST_OS
-pathTooLong path = utf16StringLength path >= win32MaxPath
+pathTooLong
+  | osIsWindows = \path -> utf16StringLength path >= win32MaxPath
+  | otherwise = const False
   where
     win32MaxPath = 260
     -- Calculate the length of a string in 16-bit units
@@ -370,6 +368,3 @@ pathTooLong path = utf16StringLength path >= win32MaxPath
       where
         utf16CharLength c | ord c < 0x10000 = 1
                           | otherwise       = 2
-#else
-pathTooLong _ = False
-#endif

src/Stack/Build/Execute.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleContexts      #-}

src/Stack/Config.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}

src/Stack/Config/Docker.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
 
 -- | Docker configuration
 module Stack.Config.Docker where

src/Stack/Constants.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-} -- keep TH usage here
@@ -132,6 +131,7 @@ import           Path as FL
 import           Stack.Prelude
 import           Stack.Types.Compiler
 import           Stack.Types.TemplateName
+import           System.Permissions (osIsWindows)
 
 -- | Extensions used for Haskell modules. Excludes preprocessor ones.
 haskellFileExts :: [Text]
@@ -325,15 +325,6 @@ maxTerminalWidth = 200
 defaultTerminalWidth :: Int
 defaultTerminalWidth = 100
 
--- | True if using Windows OS.
-osIsWindows :: Bool
-osIsWindows =
-#ifdef WINDOWS
-  True
-#else
-  False
-#endif
-
 relFileSetupHs :: Path Rel File
 relFileSetupHs = $(mkRelFile "Setup.hs")
 

src/Stack/Docker.hs

@@ -66,6 +66,7 @@ import           System.IO.Unsafe (unsafePerformIO)
 import qualified System.PosixCompat.User as User
 import qualified System.PosixCompat.Files as Files
 import           System.Process.PagerEditor (editByteString)
+import           System.Terminal (hIsTerminalDeviceOrMinTTY)
 import           RIO.Process
 import           Text.Printf (printf)
 
@@ -347,6 +348,8 @@ runContainerAndExit getCmdArgs
          ,[cmnd]
          ,args])
      before
+-- MSS 2018-08-30 can the CPP below be removed entirely, and instead exec the
+-- `docker` process so that it can handle the signals directly?
 #ifndef WINDOWS
      run <- askRunInIO
      oldHandlers <- forM [sigINT,sigABRT,sigHUP,sigPIPE,sigTERM,sigUSR1,sigUSR2] $ \sig -> do