Commit 13e12e34 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Switch all file read/writes and process output to use UTF8

Added readTextFile and writeTextFile which use UTF8. rawSystemStdout now
assumes the programs are producing output in UTF8 encoding.
parent 8c2e1b25
......@@ -76,7 +76,7 @@ import Distribution.Verbosity (Verbosity)
import Distribution.Compiler (CompilerFlavor(..))
import Distribution.PackageDescription.Configuration (parseCondition, freeVars)
import Distribution.Simple.Utils
( die, dieWithLocation, warn, intercalate, writeFileAtomic )
( die, dieWithLocation, warn, intercalate, readTextFile, writeTextFile )
-- -----------------------------------------------------------------------------
......@@ -286,7 +286,7 @@ readAndParseFile :: Verbosity -> (String -> ParseResult a) -> FilePath -> IO a
readAndParseFile verbosity parser fpath = do
exists <- doesFileExist fpath
when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
str <- readFile fpath
str <- readTextFile fpath
case parser str of
ParseFailed e -> do
let (line, message) = locatedErrorMsg e
......@@ -709,7 +709,7 @@ parseHookedBuildInfo inp = do
-- Pretty printing
writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription fpath pkg = writeFileAtomic fpath (showPackageDescription pkg)
writePackageDescription fpath pkg = writeTextFile fpath (showPackageDescription pkg)
showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render $
......@@ -729,7 +729,7 @@ ppCustomField :: (String,String) -> Doc
ppCustomField (name,val) = text name <> colon <+> showFreeText val
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo fpath pbi = writeFileAtomic fpath (showHookedBuildInfo pbi)
writeHookedBuildInfo fpath pbi = writeTextFile fpath (showHookedBuildInfo pbi)
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo (mb_lib_bi, ex_bi) = render $
......
......@@ -69,7 +69,7 @@ import Distribution.License
import Distribution.Version
import Distribution.Package ( parsePackageName )
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.Simple.Utils (intercalate, fromUTF8)
import Distribution.Simple.Utils (intercalate)
import Language.Haskell.Extension (Extension)
import Text.PrettyPrint.HughesPJ hiding (braces)
......@@ -272,7 +272,6 @@ readFields input =
. trimLines
. lines
. normaliseLineEndings
. fromUTF8
-- attach line number and determine indentation
trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)]
......@@ -774,7 +773,7 @@ main = do
checkResult :: FilePath -> IO Bool
checkResult inputFile = do
file <- readFile inputFile
file <- readTextFile inputFile
case readFields file of
ParseOk _ result -> do
hPutStrLn stderr $ inputFile ++ " parses ok :-)"
......
......@@ -61,7 +61,7 @@ import Distribution.Simple.BuildPaths ( autogenModuleName )
import Distribution.Simple.Configure
( localBuildInfoFile )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, die, setupMessage, writeFileAtomic )
( createDirectoryIfMissingVerbose, die, setupMessage, writeTextFile )
import Distribution.System
import System.FilePath ( (</>), pathSeparator )
......@@ -217,7 +217,7 @@ buildPathsModule pkg_descr lbi =
then getModificationTime paths_filepath
else return btime
if btime >= ptime
then writeFileAtomic paths_filepath (header++body)
then writeTextFile paths_filepath (header++body)
else return ()
where
InstallDirs {
......
......@@ -94,7 +94,7 @@ import Distribution.Simple.BuildPaths
( distPref )
import Distribution.Simple.Utils
( die, warn, info, setupMessage, createDirectoryIfMissingVerbose
, intercalate, comparing, writeFileAtomic )
, intercalate, comparing, readTextFile, writeTextFile )
import Distribution.Simple.Register
( removeInstalledConfig )
import Distribution.System
......@@ -143,7 +143,7 @@ tryGetConfigStateFile filename = do
let dieMsg = "error reading " ++ filename ++
"; run \"setup configure\" command?\n"
if (not e) then return $ Left dieMsg else do
str <- readFile filename
str <- readTextFile filename
case reads str of
[(bi,_)] -> return $ Right bi
_ -> return $ Left dieMsg
......@@ -171,7 +171,7 @@ maybeGetPersistBuildConfig = do
writePersistBuildConfig :: LocalBuildInfo -> IO ()
writePersistBuildConfig lbi = do
createDirectoryIfMissing False distPref
writeFileAtomic localBuildInfoFile (show lbi)
writeTextFile localBuildInfoFile (show lbi)
-- |Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
......
......@@ -309,7 +309,7 @@ getInstalledPackages' verbosity packagedbs conf = do
(UserPackageDB, _global:_) -> Nothing
(SpecificPackageDB specific, _) -> Just specific
_ -> error "cannot read ghc-pkg global package file"
sequence [ readFile file >>= \content -> return (db, read content)
sequence [ readTextFile file >>= \content -> return (db, read content)
| (db , Just file) <- zip packagedbs (map dbFile packagedbs) ]
-- -----------------------------------------------------------------------------
......
......@@ -61,8 +61,8 @@ import Distribution.Simple.BuildPaths
( autogenModuleName, autogenModulesDir,
dllExtension )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, writeFileAtomic
, findFile, dotToSep, findFileWithExtension, smartCopySources
( createDirectoryIfMissingVerbose, readTextFile, writeTextFile
, findFile, dotToSep, findFileWithExtension, smartCopySources
, die, info, notice )
import Language.Haskell.Extension
( Extension(..) )
......@@ -251,7 +251,7 @@ build pkg_descr lbi verbosity = do
-- Get the non-literate source of a Haskell module.
readHaskellFile :: FilePath -> IO String
readHaskellFile file = do
text <- readFile file
text <- readTextFile file
if ".lhs" `isSuffixOf` file
then either return die (unlit file text)
else return text
......@@ -269,7 +269,7 @@ getOptionsFromSource
[String] -- INCLUDE pragmas
)
getOptionsFromSource file = do
text <- readFile file
text <- readTextFile file
text' <- if ".lhs" `isSuffixOf` file
then either return die (unlit file text)
else return text
......@@ -383,7 +383,7 @@ install verbosity libDir installProgDir binDir targetProgDir buildPref (progpref
let args = hugsOptions ++ [targetName, "\"$@\""]
in unlines ["#! /bin/sh",
unwords ("runhugs" : args)]
writeFileAtomic exeFile script
writeTextFile exeFile script
perms <- getPermissions exeFile
setPermissions exeFile perms { executable = True, readable = True }
......
......@@ -70,7 +70,7 @@ import Distribution.Version ( VersionRange(AnyVersion) )
import Distribution.Package ( PackageIdentifier(..), showPackageId,
parsePackageId, Package(..) )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, copyFileVerbose, writeFileAtomic
( createDirectoryIfMissingVerbose, copyFileVerbose, writeTextFile
, die, info, intercalate )
import System.FilePath ( (</>) )
import Distribution.Verbosity
......@@ -140,7 +140,7 @@ build pkg_descr lbi verbosity = do
let pkgid = showPackageId (packageId pkg_descr)
pfile = buildDir lbi </> "jhc-pkg.conf"
hlfile= buildDir lbi </> (pkgid ++ ".hl")
writeFileAtomic pfile $ jhcPkgConf pkg_descr
writeTextFile pfile $ jhcPkgConf pkg_descr
rawSystemProgram verbosity jhcProg ["--build-hl="++pfile, "-o", hlfile]
withExe pkg_descr $ \exe -> do
info verbosity ("Building executable "++exeName exe)
......
......@@ -63,7 +63,8 @@ import Distribution.Package (showPackageId, Package(..))
import Distribution.Simple.Compiler (CompilerFlavor(..), Compiler(..), compilerVersion)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, writeFileAtomic, die, setupMessage
( createDirectoryIfMissingVerbose, readTextFile, writeTextFile
, die, setupMessage
, findFileWithExtension, findFileWithExtension', dotToSep )
import Distribution.Simple.Program (Program(..), ConfiguredProgram(..),
lookupProgram, programPath,
......@@ -269,8 +270,8 @@ ppUnlit =
PreProcessor {
platformIndependent = True,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile _verbosity -> do
contents <- readFile inFile
either (writeFileAtomic outFile) die (unlit inFile contents)
contents <- readTextFile inFile
either (writeTextFile outFile) die (unlit inFile contents)
}
ppCpp :: BuildInfo -> LocalBuildInfo -> PreProcessor
......
......@@ -68,7 +68,7 @@ import Distribution.InstalledPackageInfo
emptyInstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, copyFileVerbose, writeFileAtomic
( createDirectoryIfMissingVerbose, copyFileVerbose, writeTextFile
, die, info, notice, setupMessage )
import Distribution.System
......@@ -172,7 +172,7 @@ writeInstalledConfig pkg_descr lbi inplace instConfOverride = do
let instConfDefault | inplace = inplacePkgConfigFile
| otherwise = installedPkgConfigFile
instConf = fromMaybe instConfDefault instConfOverride
writeFileAtomic instConf (pkg_config ++ "\n")
writeTextFile instConf (pkg_config ++ "\n")
-- |Create a string suitable for writing out to the package config file
showInstalledConfig :: PackageDescription -> LocalBuildInfo -> Bool
......@@ -310,8 +310,8 @@ rawSystemEmit :: ConfiguredProgram -- ^Program to run
rawSystemEmit prog scriptName extraArgs
= case os of
Windows _ ->
writeFileAtomic scriptName ("@" ++ path ++ concatMap (' ':) args)
_ -> do writeFileAtomic scriptName ("#!/bin/sh\n\n"
writeTextFile scriptName ("@" ++ path ++ concatMap (' ':) args)
_ -> do writeTextFile scriptName ("#!/bin/sh\n\n"
++ (path ++ concatMap (' ':) args)
++ "\n")
p <- getPermissions scriptName
......@@ -328,8 +328,8 @@ rawSystemPipe :: ConfiguredProgram
rawSystemPipe prog scriptName pipeFrom extraArgs
= case os of
Windows _ ->
writeFileAtomic scriptName ("@" ++ path ++ concatMap (' ':) args)
_ -> do writeFileAtomic scriptName ("#!/bin/sh\n\n"
writeTextFile scriptName ("@" ++ path ++ concatMap (' ':) args)
_ -> do writeTextFile scriptName ("#!/bin/sh\n\n"
++ "echo '" ++ escapeForShell pipeFrom
++ "' | "
++ (path ++ concatMap (' ':) args)
......
......@@ -99,7 +99,7 @@ setupWrapper args mdir = inDir mdir $ do
then mainAction args -- current version is OK, so no need
-- to compile a special Setup.hs.
else do createDirectoryIfMissingVerbose verbosity True setupDir
writeFileAtomic setupHs mainText
writeTextFile setupHs mainText
trySetupScript setupHs $ error "panic! shouldn't happen"
Nothing ->
trySetupScript "Setup.hs" $
......
......@@ -60,8 +60,8 @@ import Distribution.PackageDescription.Check
import Distribution.Package (showPackageId, PackageIdentifier(pkgVersion), Package(..))
import Distribution.Version (Version(versionBranch), VersionRange(AnyVersion))
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, writeFileAtomic, copyFiles
, copyFileVerbose, findFile, findFileWithExtension, dotToSep
( createDirectoryIfMissingVerbose, readTextFile, writeTextFile
, copyFiles, copyFileVerbose, findFile, findFileWithExtension, dotToSep
, die, warn, notice, setupMessage, defaultPackageDesc )
import Distribution.Simple.Setup (SDistFlags(..), fromFlag)
import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources)
......@@ -168,7 +168,7 @@ prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date = do
lhsExists <- doesFileExist "Setup.lhs"
if hsExists then copyFileTo verbosity targetDir "Setup.hs"
else if lhsExists then copyFileTo verbosity targetDir "Setup.lhs"
else writeFileAtomic (targetDir </> "Setup.hs") $ unlines [
else writeTextFile (targetDir </> "Setup.hs") $ unlines [
"import Distribution.Simple",
"main = defaultMainWithHooks defaultUserHooks"]
-- the description file itself
......@@ -177,8 +177,8 @@ prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date = do
-- We could just writePackageDescription targetDescFile pkg_descr,
-- but that would lose comments and formatting.
if snapshot then do
contents <- readFile descFile
writeFileAtomic targetDescFile $
contents <- readTextFile descFile
writeTextFile targetDescFile $
unlines $ map (appendVersion date) $ lines $ contents
else copyFileVerbose verbosity descFile targetDescFile
return targetDir
......
......@@ -76,6 +76,8 @@ module Distribution.Simple.Utils (
findFile,
findFileWithExtension,
findFileWithExtension',
-- * files
withTempFile,
writeFileAtomic,
......@@ -88,6 +90,8 @@ module Distribution.Simple.Utils (
-- * Unicode
fromUTF8,
toUTF8,
readTextFile,
writeTextFile,
-- * generic utils
equating,
......@@ -267,7 +271,10 @@ rawSystemExit verbosity path args = do
hFlush stdout
maybeExit $ rawSystem path args
-- Run a command and return its output
-- | Run a command and return its output.
--
-- The output is assumed to be encoded as UTF8.
--
rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO String
rawSystemStdout verbosity path args = do
(output, exitCode) <- rawSystemStdout' verbosity path args
......@@ -293,7 +300,7 @@ rawSystemStdout' verbosity path args = do
forkIO $ do evaluate (length err); return ()
-- wait for all the output
output <- hGetContents outh
output <- fromUTF8 `fmap` hGetContents outh
evaluate (length output)
-- wait for the program to terminate
......@@ -306,7 +313,7 @@ rawSystemStdout' verbosity path args = do
hClose tmpHandle
let quote name = "'" ++ name ++ "'"
exitCode <- system $ unwords (map quote (path:args)) ++ " >" ++ quote tmpName
output <- readFile tmpName
output <- readTextFile tmpName
length output `seq` return (output, exitCode)
#endif
......@@ -594,7 +601,7 @@ findHookedPackageDesc dir = do
_ -> die ("Multiple files with extension " ++ buildInfoExt)
-- ------------------------------------------------------------
-- * UTF8 <-> Unicode String Conversions
-- * Unicode stuff
-- ------------------------------------------------------------
-- This is a modification of the UTF8 code from gtk2hs
......@@ -633,6 +640,20 @@ toUTF8 (c:cs)
: toUTF8 cs
where w = ord c
-- | Reads a UTF8 encoded text file as a Unicode String
--
-- Reads lazily using ordinary 'readFile'.
--
readTextFile :: FilePath -> IO String
readTextFile = fmap fromUTF8 . readFile
-- | Writes a Unicode String as a UTF8 encoded text file.
--
-- Uses 'writeFileAtomic', so provides the same guarantees.
--
writeTextFile :: FilePath -> String -> IO ()
writeTextFile path = writeFileAtomic path . toUTF8
-- ------------------------------------------------------------
-- * Common utils
-- ------------------------------------------------------------
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment