Refactor/cleanup of String/ByteString usage

Cabal/Cabal.cabal

@@ -126,6 +126,7 @@ library
     Distribution.Backpack.ModSubst
     Distribution.Backpack.ModuleShape
     Distribution.Backpack.PreModuleShape
+    Distribution.Utils.IOData
     Distribution.Utils.LogProgress
     Distribution.Utils.MapAccum
     Distribution.Compat.CreatePipe

Cabal/Distribution/PackageDescription/Check.hs

@@ -58,6 +58,7 @@ import Distribution.Text
 import Language.Haskell.Extension
 
 import Control.Monad (mapM)
+import qualified Data.ByteString.Lazy as BS
 import Data.List  (group)
 import qualified System.Directory as System
          ( doesFileExist, doesDirectoryExist )
@@ -67,7 +68,6 @@ import qualified Text.PrettyPrint as Disp
 import Text.PrettyPrint ((<+>))
 
 import qualified System.Directory (getDirectoryContents)
-import System.IO (openBinaryFile, IOMode(ReadMode), hGetContents)
 import System.FilePath
          ( (</>), (<.>), takeExtension, takeFileName, splitDirectories
          , splitPath, splitExtension )
@@ -1726,8 +1726,7 @@ checkPackageFiles pkg root = checkPackageContent checkFilesIO pkg
       doesFileExist        = System.doesFileExist                  . relative,
       doesDirectoryExist   = System.doesDirectoryExist             . relative,
       getDirectoryContents = System.Directory.getDirectoryContents . relative,
-      getFileContents      = \f -> openBinaryFile (relative f) ReadMode
-                                   >>= hGetContents
+      getFileContents      = BS.readFile
     }
     relative path = root </> path
 
@@ -1738,7 +1737,7 @@ data CheckPackageContentOps m = CheckPackageContentOps {
     doesFileExist        :: FilePath -> m Bool,
     doesDirectoryExist   :: FilePath -> m Bool,
     getDirectoryContents :: FilePath -> m [FilePath],
-    getFileContents      :: FilePath -> m String
+    getFileContents      :: FilePath -> m BS.ByteString
   }
 
 -- | Sanity check things that requires looking at files in the package.
@@ -1777,12 +1776,16 @@ checkCabalFileBOM ops = do
     -- --cabal-file is specified.  So if you can't find the file,
     -- just don't bother with this check.
     Left _       -> return $ Nothing
-    Right pdfile -> (flip check pc . startsWithBOM . fromUTF8)
+    Right pdfile -> (flip check pc . BS.isPrefixOf bomUtf8)
                     `liftM` (getFileContents ops pdfile)
       where pc = PackageDistInexcusable $
                  pdfile ++ " starts with an Unicode byte order mark (BOM)."
                  ++ " This may cause problems with older cabal versions."
 
+  where
+    bomUtf8 :: BS.ByteString
+    bomUtf8 = BS.pack [0xef,0xbb,0xbf] -- U+FEFF encoded as UTF8
+
 checkCabalFileName :: Monad m => CheckPackageContentOps m
                  -> PackageDescription
                  -> m (Maybe PackageCheck)

Cabal/Distribution/Simple/Program/Run.hs

@@ -62,6 +62,10 @@ data ProgramInvocation = ProgramInvocation {
 data IOEncoding = IOEncodingText   -- locale mode text
                 | IOEncodingUTF8   -- always utf8
 
+encodeToIOData :: IOEncoding -> String -> IOData
+encodeToIOData IOEncodingText = IODataText
+encodeToIOData IOEncodingUTF8 = IODataBinary . toUTF8LBS
+
 emptyProgramInvocation :: ProgramInvocation
 emptyProgramInvocation =
   ProgramInvocation {
@@ -138,15 +142,11 @@ runProgramInvocation verbosity
     (_, errors, exitCode) <- rawSystemStdInOut verbosity
                                     path args
                                     mcwd menv
-                                    (Just input) True
+                                    (Just input) IODataModeBinary
     when (exitCode /= ExitSuccess) $
       die' verbosity $ "'" ++ path ++ "' exited with an error:\n" ++ errors
   where
-    input = case encoding of
-              IOEncodingText -> (inputStr, False)
-              IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for
-                                                        -- utf8
-
+    input = encodeToIOData encoding inputStr
 
 getProgramInvocationOutput :: Verbosity -> ProgramInvocation -> IO String
 getProgramInvocationOutput verbosity inv = do
@@ -168,25 +168,21 @@ getProgramInvocationOutputAndErrors verbosity
     progInvokeInput = minputStr,
     progInvokeOutputEncoding = encoding
   } = do
-    let utf8 = case encoding of IOEncodingUTF8 -> True; _ -> False
-        decode | utf8      = fromUTF8 . normaliseLineEndings
-               | otherwise = id
+    let mode = case encoding of IOEncodingUTF8 -> IODataModeBinary
+                                IOEncodingText -> IODataModeText
+
+        decode (IODataBinary b) = normaliseLineEndings (fromUTF8LBS b)
+        decode (IODataText   s) = s
+
     pathOverride <- getExtraPathEnv envOverrides extraPath
     menv <- getEffectiveEnvironment (envOverrides ++ pathOverride)
     (output, errors, exitCode) <- rawSystemStdInOut verbosity
                                     path args
                                     mcwd menv
-                                    input utf8
+                                    input mode
     return (decode output, errors, exitCode)
   where
-    input =
-      case minputStr of
-        Nothing       -> Nothing
-        Just inputStr -> Just $
-          case encoding of
-            IOEncodingText -> (inputStr, False)
-            IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for utf8
-
+    input = encodeToIOData encoding <$> minputStr
 
 getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> NoCallStackIO [(String, Maybe String)]
 getExtraPathEnv _ [] = return []

Cabal/Distribution/Simple/Utils.hs

@@ -57,6 +57,14 @@ module Distribution.Simple.Utils (
         findProgramLocation,
         findProgramVersion,
 
+        -- ** 'IOData' re-export
+        --
+        -- These types are re-exported from
+        -- "Distribution.Utils.IOData" for convience as they're
+        -- exposed in the API of 'rawSystemStdInOut'
+        IOData(..),
+        IODataMode(..),
+
         -- * copying files
         smartCopySources,
         createDirectoryIfMissingVerbose,
@@ -128,18 +136,16 @@ module Distribution.Simple.Utils (
         rewriteFile,
 
         -- * Unicode
-        fromUTF8,
         fromUTF8BS,
         fromUTF8LBS,
-        toUTF8,
+        toUTF8BS,
+        toUTF8LBS,
         readUTF8File,
         withUTF8FileContents,
         writeUTF8File,
         normaliseLineEndings,
 
         -- * BOM
-        startsWithBOM,
-        fileHasBOM,
         ignoreBOM,
 
         -- * generic utils
@@ -170,6 +176,8 @@ import Distribution.Compat.Prelude
 
 import Distribution.Text
 import Distribution.Utils.Generic
+import Distribution.Utils.IOData (IOData(..), IODataMode(..))
+import qualified Distribution.Utils.IOData as IOData
 import Distribution.ModuleName as ModuleName
 import Distribution.System
 import Distribution.Version
@@ -801,9 +809,9 @@ createProcessWithEnv verbosity path args mcwd menv inp out err = withFrozenCallS
 --
 rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO String
 rawSystemStdout verbosity path args = withFrozenCallStack $ do
-  (output, errors, exitCode) <- rawSystemStdInOut verbosity path args
+  (IODataText output, errors, exitCode) <- rawSystemStdInOut verbosity path args
                                                   Nothing Nothing
-                                                  Nothing False
+                                                  Nothing IODataModeText
   when (exitCode /= ExitSuccess) $
     die errors
   return output
@@ -817,10 +825,10 @@ rawSystemStdInOut :: Verbosity
                   -> [String]                 -- ^ Arguments
                   -> Maybe FilePath           -- ^ New working dir or inherit
                   -> Maybe [(String, String)] -- ^ New environment or inherit
-                  -> Maybe (String, Bool)     -- ^ input text and binary mode
-                  -> Bool                     -- ^ output in binary mode
-                  -> IO (String, String, ExitCode) -- ^ output, errors, exit
-rawSystemStdInOut verbosity path args mcwd menv input outputBinary = withFrozenCallStack $ do
+                  -> Maybe IOData             -- ^ input text and binary mode
+                  -> IODataMode               -- ^ output in binary mode
+                  -> IO (IOData, String, ExitCode) -- ^ output, errors, exit
+rawSystemStdInOut verbosity path args mcwd menv input outputMode = withFrozenCallStack $ do
   printRawCommandAndArgs verbosity path args
 
   Exception.bracket
@@ -829,31 +837,29 @@ rawSystemStdInOut verbosity path args mcwd menv input outputBinary = withFrozenC
     $ \(inh,outh,errh,pid) -> do
 
       -- output mode depends on what the caller wants
-      hSetBinaryMode outh outputBinary
       -- but the errors are always assumed to be text (in the current locale)
       hSetBinaryMode errh False
 
       -- fork off a couple threads to pull on the stderr and stdout
       -- so if the process writes to stderr we do not block.
 
       err <- hGetContents errh
-      out <- hGetContents outh
+
+      out <- IOData.hGetContents outh outputMode
 
       mv <- newEmptyMVar
       let force str = do
-            mberr <- Exception.try (evaluate (length str) >> return ())
+            mberr <- Exception.try (evaluate (rnf str) >> return ())
             putMVar mv (mberr :: Either IOError ())
       _ <- forkIO $ force out
       _ <- forkIO $ force err
 
       -- push all the input, if any
       case input of
         Nothing -> return ()
-        Just (inputStr, inputBinary) -> do
-                -- input mode depends on what the caller wants
-          hSetBinaryMode inh inputBinary
-          hPutStr inh inputStr
-          hClose inh
+        Just inputData -> do
+          -- input mode depends on what the caller wants
+          IOData.hPutContents inh inputData
           --TODO: this probably fails if the process refuses to consume
           -- or if it closes stdin (eg if it exits)
 
@@ -869,8 +875,9 @@ rawSystemStdInOut verbosity path args mcwd menv input outputBinary = withFrozenC
                           " with error message:\n" ++ err
                        ++ case input of
                             Nothing       -> ""
-                            Just ("",  _) -> ""
-                            Just (inp, _) -> "\nstdin input:\n" ++ inp
+                            Just d | IOData.null d -> ""
+                            Just (IODataText inp) -> "\nstdin input:\n" ++ inp
+                            Just (IODataBinary inp) -> "\nstdin input (binary):\n" ++ show inp
 
       -- Check if we we hit an exception while consuming the output
       -- (e.g. a text decoding error)