Make ghc-cabal's `System.Directory` import more robust
[ghc.git] / utils / ghc-cabal / Main.hs
index d64c224..6da7733 100644 (file)
@@ -6,11 +6,15 @@ import Distribution.PackageDescription
 import Distribution.PackageDescription.Check hiding (doesFileExist)
 import Distribution.PackageDescription.Configuration
 import Distribution.PackageDescription.Parse
+import Distribution.Package
+import Distribution.System
 import Distribution.Simple
 import Distribution.Simple.Configure
 import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.GHC
 import Distribution.Simple.Program
 import Distribution.Simple.Program.HcPkg
+import Distribution.Simple.Setup (ConfigFlags(configStripLibs), fromFlag, toFlag)
 import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic, toUTF8)
 import Distribution.Simple.Build (writeAutogenFiles)
 import Distribution.Simple.Register
@@ -19,32 +23,40 @@ import Distribution.Verbosity
 import qualified Distribution.InstalledPackageInfo as Installed
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 
+import Control.Exception (bracket)
+import Control.Monad
+import qualified Data.ByteString.Lazy.Char8 as BS
 import Data.List
 import Data.Maybe
 import System.IO
-import System.Directory
+import System.Directory (setCurrentDirectory, getCurrentDirectory, doesFileExist)
 import System.Environment
-import System.Exit
+import System.Exit      (exitWith, ExitCode(..))
 import System.FilePath
 
 main :: IO ()
 main = do hSetBuffering stdout LineBuffering
           args <- getArgs
           case args of
-              "hscolour" : distDir : dir : args' ->
-                  runHsColour distDir dir args'
+              "hscolour" : dir : distDir : args' ->
+                  runHsColour dir distDir args'
               "check" : dir : [] ->
                   doCheck dir
-              "install" : ghc : ghcpkg : strip : topdir : directory : distDir
-                        : myDestDir : myPrefix : myLibdir : myDocdir
-                        : relocatableBuild : args' ->
-                  doInstall ghc ghcpkg strip topdir directory distDir
-                            myDestDir myPrefix myLibdir myDocdir
-                            relocatableBuild args'
-              "configure" : args' -> case break (== "--") args' of
-                   (config_args, "--" : distdir : directories) ->
-                       mapM_ (generate config_args distdir) directories
-                   _ -> die syntax_error
+              "copy" : dir : distDir
+                     : strip : myDestDir : myPrefix : myLibdir : myDocdir
+                     : ghcLibWays : args' ->
+                  doCopy dir distDir
+                         strip myDestDir myPrefix myLibdir myDocdir
+                         ("dyn" `elem` words ghcLibWays)
+                         args'
+              "register" : dir : distDir : ghc : ghcpkg : topdir
+                         : myDestDir : myPrefix : myLibdir : myDocdir
+                         : relocatableBuild : args' ->
+                  doRegister dir distDir ghc ghcpkg topdir
+                             myDestDir myPrefix myLibdir myDocdir
+                             relocatableBuild args'
+              "configure" : dir : distDir : dll0Modules : config_args ->
+                  generate dir distDir dll0Modules config_args
               "sdist" : dir : distDir : [] ->
                   doSdist dir distDir
               ["--version"] ->
@@ -61,14 +73,10 @@ die :: [String] -> IO a
 die errs = do mapM_ (hPutStrLn stderr) errs
               exitWith (ExitFailure 1)
 
--- XXX Should use bracket
 withCurrentDirectory :: FilePath -> IO a -> IO a
 withCurrentDirectory directory io
- = do curDirectory <- getCurrentDirectory
-      setCurrentDirectory directory
-      r <- io
-      setCurrentDirectory curDirectory
-      return r
+ = bracket (getCurrentDirectory) (setCurrentDirectory)
+           (const (setCurrentDirectory directory >> io))
 
 -- We need to use the autoconfUserHooks, as the packages that use
 -- configure can create a .buildinfo file, and we need any info that
@@ -106,50 +114,38 @@ doCheck directory
  $ do let verbosity = normal
       gpdFile <- defaultPackageDesc verbosity
       gpd <- readPackageDescription verbosity gpdFile
-      case partition isFailure $ checkPackage gpd Nothing of
-          ([],   [])       -> return ()
-          ([],   warnings) -> mapM_ print warnings
-          (errs, _)        -> do mapM_ print errs
-                                 exitWith (ExitFailure 1)
+      case filter isFailure $ checkPackage gpd Nothing of
+          []   -> return ()
+          errs -> mapM_ print errs >> exitWith (ExitFailure 1)
     where isFailure (PackageDistSuspicious {}) = False
+          isFailure (PackageDistSuspiciousWarn {}) = False
           isFailure _ = True
 
 runHsColour :: FilePath -> FilePath -> [String] -> IO ()
-runHsColour distdir directory args
+runHsColour directory distdir args
  = withCurrentDirectory directory
  $ defaultMainArgs ("hscolour" : "--builddir" : distdir : args)
 
-doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
-          -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
-          -> String -> [String]
-          -> IO ()
-doInstall ghc ghcpkg strip topdir directory distDir
-          myDestDir myPrefix myLibdir myDocdir
-          relocatableBuildStr args
+doCopy :: FilePath -> FilePath
+       -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> Bool
+       -> [String]
+       -> IO ()
+doCopy directory distDir
+       strip myDestDir myPrefix myLibdir myDocdir withSharedLibs
+       args
  = withCurrentDirectory directory $ do
-     relocatableBuild <- case relocatableBuildStr of
-                         "YES" -> return True
-                         "NO"  -> return False
-                         _ -> die ["Bad relocatableBuildStr: " ++
-                                   show relocatableBuildStr]
      let copyArgs = ["copy", "--builddir", distDir]
                  ++ (if null myDestDir
                      then []
                      else ["--destdir", myDestDir])
                  ++ args
-         regArgs = "register" : "--builddir" : distDir : args
          copyHooks = userHooks {
                          copyHook = noGhcPrimHook
                                   $ modHook False
                                   $ copyHook userHooks
                      }
-         regHooks = userHooks {
-                        regHook = modHook relocatableBuild
-                                $ regHook userHooks
-                    }
 
      defaultMainWithHooksArgs copyHooks copyArgs
-     defaultMainWithHooksArgs regHooks  regArgs
     where
       noGhcPrimHook f pd lbi us flags
               = let pd'
@@ -166,111 +162,139 @@ doInstall ghc ghcpkg strip topdir directory distDir
                 in f pd' lbi us flags
       modHook relocatableBuild f pd lbi us flags
        = do let verbosity = normal
-                idts = installDirTemplates lbi
-                idts' = idts {
-                            prefix    = toPathTemplate $
-                                            if relocatableBuild
-                                            then "$topdir"
-                                            else myPrefix,
-                            libdir    = toPathTemplate $
-                                            if relocatableBuild
-                                            then "$topdir"
-                                            else myLibdir,
-                            libsubdir = toPathTemplate "$pkgid",
-                            docdir    = toPathTemplate $
-                                            if relocatableBuild
-                                            then "$topdir/../doc/html/libraries/$pkgid"
-                                            else (myDocdir </> "$pkgid"),
-                            htmldir   = toPathTemplate "$docdir"
-                        }
+                idts = updateInstallDirTemplates relocatableBuild
+                                                 myPrefix myLibdir myDocdir
+                                                 (installDirTemplates lbi)
+                progs = withPrograms lbi
+                stripProgram' = stripProgram {
+                    programFindLocation = \_ _ -> return (Just strip) }
+
+            progs' <- configureProgram verbosity stripProgram' progs
+            let lbi' = lbi {
+                               withPrograms = progs',
+                               installDirTemplates = idts,
+                               configFlags = cfg,
+                               stripLibs = fromFlag (configStripLibs cfg),
+                               withSharedLib = withSharedLibs
+                           }
+
+                -- This hack allows to interpret the "strip"
+                -- command-line argument being set to ':' to signify
+                -- disabled library stripping
+                cfg | strip == ":" = (configFlags lbi) { configStripLibs = toFlag False }
+                    | otherwise    = configFlags lbi
+
+            f pd lbi' us flags
+
+doRegister :: FilePath -> FilePath -> FilePath -> FilePath
+           -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
+           -> String -> [String]
+           -> IO ()
+doRegister directory distDir ghc ghcpkg topdir
+           myDestDir myPrefix myLibdir myDocdir
+           relocatableBuildStr args
+ = withCurrentDirectory directory $ do
+     relocatableBuild <- case relocatableBuildStr of
+                         "YES" -> return True
+                         "NO"  -> return False
+                         _ -> die ["Bad relocatableBuildStr: " ++
+                                   show relocatableBuildStr]
+     let regArgs = "register" : "--builddir" : distDir : args
+         regHooks = userHooks {
+                        regHook = modHook relocatableBuild
+                                $ regHook userHooks
+                    }
+
+     defaultMainWithHooksArgs regHooks  regArgs
+    where
+      modHook relocatableBuild f pd lbi us flags
+       = do let verbosity = normal
+                idts = updateInstallDirTemplates relocatableBuild
+                                                 myPrefix myLibdir myDocdir
+                                                 (installDirTemplates lbi)
                 progs = withPrograms lbi
-                ghcProg = ConfiguredProgram {
-                              programId = programName ghcProgram,
-                              programVersion = Nothing,
-                              programDefaultArgs = ["-B" ++ topdir],
-                              programOverrideArgs = [],
-                              programLocation = UserSpecified ghc
-                          }
                 ghcpkgconf = topdir </> "package.conf.d"
-                ghcPkgProg = ConfiguredProgram {
-                                 programId = programName ghcPkgProgram,
-                                 programVersion = Nothing,
-                                 programDefaultArgs = ["--global-conf",
-                                                       ghcpkgconf]
-                                               ++ if not (null myDestDir)
-                                                  then ["--force"]
-                                                  else [],
-                                 programOverrideArgs = [],
-                                 programLocation = UserSpecified ghcpkg
-                             }
-                stripProg = ConfiguredProgram {
-                              programId = programName stripProgram,
-                              programVersion = Nothing,
-                              programDefaultArgs = [],
-                              programOverrideArgs = [],
-                              programLocation = UserSpecified strip
-                          }
-                progs' = updateProgram ghcProg
-                       $ updateProgram ghcPkgProg
-                       $ updateProgram stripProg
-                         progs
-            instInfos <- dump verbosity ghcPkgProg GlobalPackageDB
+                ghcProgram' = ghcProgram {
+                    programPostConf = \_ cp -> return cp { programDefaultArgs = ["-B" ++ topdir] },
+                    programFindLocation = \_ _ -> return (Just ghc) }
+                ghcPkgProgram' = ghcPkgProgram {
+                    programPostConf = \_ cp -> return cp { programDefaultArgs =
+                                                                ["--global-package-db", ghcpkgconf]
+                                                                ++ ["--force" | not (null myDestDir) ] },
+                    programFindLocation = \_ _ -> return (Just ghcpkg) }
+                configurePrograms ps conf = foldM (flip (configureProgram verbosity)) conf ps
+
+            progs' <- configurePrograms [ghcProgram', ghcPkgProgram'] progs
+            instInfos <- dump (hcPkgInfo progs') verbosity GlobalPackageDB
             let installedPkgs' = PackageIndex.fromList instInfos
-            let mlc = libraryConfig lbi
-                mlc' = case mlc of
-                       Just lc ->
-                           let cipds = componentPackageDeps lc
-                               cipds' = [ (fixupPackageId instInfos ipid, pid)
-                                        | (ipid,pid) <- cipds ]
-                           in Just $ lc {
-                                         componentPackageDeps = cipds'
-                                     }
-                       Nothing -> Nothing
+            let updateComponentConfig (cn, clbi, deps)
+                    = (cn, updateComponentLocalBuildInfo clbi, deps)
+                updateComponentLocalBuildInfo clbi = clbi -- TODO: remove
+                ccs' = map updateComponentConfig (componentsConfigs lbi)
                 lbi' = lbi {
-                               libraryConfig = mlc',
+                               componentsConfigs = ccs',
                                installedPkgs = installedPkgs',
-                               installDirTemplates = idts',
+                               installDirTemplates = idts,
                                withPrograms = progs'
                            }
             f pd lbi' us flags
 
--- The packages are built with the package ID ending in "-inplace", but
--- when they're installed they get the package hash appended. We need to
--- fix up the package deps so that they use the hash package IDs, not
--- the inplace package IDs.
-fixupPackageId :: [Installed.InstalledPackageInfo]
-               -> InstalledPackageId
-               -> InstalledPackageId
-fixupPackageId _ x@(InstalledPackageId ipi)
- | "builtin_" `isPrefixOf` ipi = x
-fixupPackageId ipinfos (InstalledPackageId ipi)
- = case stripPrefix (reverse "-inplace") $ reverse ipi of
-   Nothing ->
-       error ("Installed package ID doesn't end in -inplace: " ++ show ipi)
-   Just x ->
-       let ipi' = reverse ('-' : x)
-           f (ipinfo : ipinfos') = case Installed.installedPackageId ipinfo of
-                                   y@(InstalledPackageId ipinfoid)
-                                    | ipi' `isPrefixOf` ipinfoid ->
-                                       y
-                                   _ ->
-                                       f ipinfos'
-           f [] = error ("Installed package ID not registered: " ++ show ipi)
-       in f ipinfos
-
-generate :: [String] -> FilePath -> FilePath -> IO ()
-generate config_args distdir directory
+updateInstallDirTemplates :: Bool -> FilePath -> FilePath -> FilePath
+                          -> InstallDirTemplates
+                          -> InstallDirTemplates
+updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts
+    = idts {
+          prefix    = toPathTemplate $
+                          if relocatableBuild
+                          then "$topdir"
+                          else myPrefix,
+          libdir    = toPathTemplate $
+                          if relocatableBuild
+                          then "$topdir"
+                          else myLibdir,
+          libsubdir = toPathTemplate "$libname",
+          docdir    = toPathTemplate $
+                          if relocatableBuild
+                          then "$topdir/../doc/html/libraries/$pkgid"
+                          else (myDocdir </> "$pkgid"),
+          htmldir   = toPathTemplate "$docdir"
+      }
+
+-- On Windows we need to split the ghc package into 2 pieces, or the
+-- DLL that it makes contains too many symbols (#5987). There are
+-- therefore 2 libraries, not just the 1 that Cabal assumes.
+mangleIPI :: FilePath -> FilePath -> LocalBuildInfo
+          -> Installed.InstalledPackageInfo -> Installed.InstalledPackageInfo
+mangleIPI "compiler" "stage2" lbi ipi
+ | isWindows =
+    -- Cabal currently only ever installs ONE Haskell library, c.f.
+    -- the code in Cabal.Distribution.Simple.Register.  If it
+    -- ever starts installing more we'll have to find the
+    -- library that's too big and split that.
+    let [old_hslib] = Installed.hsLibraries ipi
+    in ipi {
+        Installed.hsLibraries = [old_hslib, old_hslib ++ "-0"]
+    }
+    where isWindows = case hostPlatform lbi of
+                      Platform _ Windows -> True
+                      _                  -> False
+mangleIPI _ _ _ ipi = ipi
+
+generate :: FilePath -> FilePath -> String -> [String] -> IO ()
+generate directory distdir dll0Modules config_args
  = withCurrentDirectory directory
  $ do let verbosity = normal
       -- XXX We shouldn't just configure with the default flags
       -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
       -- aren't going to work when the deps aren't built yet
-      withArgs (["configure", "--distdir", distdir] ++ config_args)
+      withArgs (["configure", "--distdir", distdir, "--ipid", "$pkg-$version"] ++ config_args)
                runDefaultMain
 
       lbi <- getPersistBuildConfig distdir
       let pd0 = localPkgDescr lbi
 
+      writePersistBuildConfig distdir lbi
+
       hooked_bi <-
            if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
            then do
@@ -287,22 +311,21 @@ generate config_args distdir directory
       writeAutogenFiles verbosity pd lbi
 
       -- generate inplace-pkg-config
-      case (library pd, libraryConfig lbi) of
-          (Nothing, Nothing) -> return ()
-          (Just lib, Just clbi) -> do
-              cwd <- getCurrentDirectory
-              let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
-              let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
-                                         pd lib lbi clbi
-                  final_ipi = installedPkgInfo {
-                                  Installed.installedPackageId = ipid,
-                                  Installed.haddockHTMLs = ["../" ++ display (packageId pd)]
-                              }
-                  content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
-              writeFileAtomic (distdir </> "inplace-pkg-config") (toUTF8 content)
-          _ -> error "Inconsistent lib components; can't happen?"
+      withLibLBI pd lbi $ \lib clbi ->
+          do cwd <- getCurrentDirectory
+             let ipid = ComponentId (display (packageId pd))
+             let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
+                                        pd (Installed.AbiHash "") lib lbi clbi
+                 final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo {
+                                 Installed.installedComponentId = ipid,
+                                 Installed.compatPackageKey = ipid,
+                                 Installed.haddockHTMLs = []
+                             }
+                 content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
+             writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content)
 
       let
+          comp = compiler lbi
           libBiModules lib = (libBuildInfo lib, libModules lib)
           exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
           biModuless = (maybeToList $ fmap libBiModules $ library pd)
@@ -343,19 +366,60 @@ generate config_args distdir directory
                         -- the RTS's library-dirs here.
               _ -> error "No (or multiple) ghc rts package is registered!!"
 
-          dep_ids = map snd (externalPackageDeps lbi)
+          dep_ids  = map snd (externalPackageDeps lbi)
+          deps     = map display dep_ids
+          dep_direct = map (fromMaybe (error "ghc-cabal: dep_keys failed")
+                           . PackageIndex.lookupComponentId
+                                            (installedPkgs lbi)
+                           . fst)
+                       . externalPackageDeps
+                       $ lbi
+          dep_ipids = map (display . Installed.installedComponentId) dep_direct
+          depLibNames
+            | packageKeySupported comp = dep_ipids
+            | otherwise = deps
+          depNames = map (display . packageName) dep_ids
 
+          transitive_dep_ids = map Installed.sourcePackageId dep_pkgs
+          transitiveDeps = map display transitive_dep_ids
+          transitiveDepLibNames
+            | packageKeySupported comp = map fixupRtsLibName transitiveDeps
+            | otherwise = transitiveDeps
+          fixupRtsLibName "rts-1.0" = "rts"
+          fixupRtsLibName x = x
+          transitiveDepNames = map (display . packageName) transitive_dep_ids
+
+          libraryDirs = forDeps Installed.libraryDirs
+          -- The mkLibraryRelDir function is a bit of a hack.
+          -- Ideally it should be handled in the makefiles instead.
+          mkLibraryRelDir "rts"   = "rts/dist/build"
+          mkLibraryRelDir "ghc"   = "compiler/stage2/build"
+          mkLibraryRelDir "Cabal" = "libraries/Cabal/Cabal/dist-install/build"
+          mkLibraryRelDir l       = "libraries/" ++ l ++ "/dist-install/build"
+          libraryRelDirs = map mkLibraryRelDir transitiveDepNames
       wrappedIncludeDirs <- wrap $ forDeps Installed.includeDirs
-      wrappedLibraryDirs <- wrap $ forDeps Installed.libraryDirs
+      wrappedLibraryDirs <- wrap libraryDirs
 
       let variablePrefix = directory ++ '_':distdir
+          mods      = map display modules
+          otherMods = map display (otherModules bi)
+          allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
-                variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
-                variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords (map display (otherModules bi)),
+                -- TODO: move inside withLibLBI
+                variablePrefix ++ "_COMPONENT_ID = " ++ display (localCompatPackageKey lbi),
+                -- copied from mkComponentsLocalBuildInfo
+                variablePrefix ++ "_COMPONENT_ID = " ++ display (localComponentId lbi),
+                variablePrefix ++ "_MODULES = " ++ unwords mods,
+                variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,
                 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
-                variablePrefix ++ "_DEPS = " ++ unwords (map display dep_ids),
-                variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) dep_ids),
+                variablePrefix ++ "_DEPS = " ++ unwords deps,
+                variablePrefix ++ "_DEP_IPIDS = " ++ unwords dep_ipids,
+                variablePrefix ++ "_DEP_NAMES = " ++ unwords depNames,
+                variablePrefix ++ "_DEP_COMPONENT_IDS = " ++ unwords depLibNames,
+                variablePrefix ++ "_TRANSITIVE_DEPS = " ++ unwords transitiveDeps,
+                variablePrefix ++ "_TRANSITIVE_DEP_COMPONENT_IDS = " ++ unwords transitiveDepLibNames,
+                variablePrefix ++ "_TRANSITIVE_DEP_NAMES = " ++ unwords transitiveDepNames,
                 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
                 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
                 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
@@ -378,6 +442,9 @@ generate config_args distdir directory
                 variablePrefix ++ "_DEP_INCLUDE_DIRS_SINGLE_QUOTED = " ++ unwords wrappedIncludeDirs,
                 variablePrefix ++ "_DEP_CC_OPTS = "                    ++ unwords (forDeps Installed.ccOptions),
                 variablePrefix ++ "_DEP_LIB_DIRS_SINGLE_QUOTED = "     ++ unwords wrappedLibraryDirs,
+                variablePrefix ++ "_DEP_LIB_DIRS_SEARCHPATH = "        ++ mkSearchPath libraryDirs,
+                variablePrefix ++ "_DEP_LIB_REL_DIRS = "               ++ unwords libraryRelDirs,
+                variablePrefix ++ "_DEP_LIB_REL_DIRS_SEARCHPATH = "    ++ mkSearchPath libraryRelDirs,
                 variablePrefix ++ "_DEP_EXTRA_LIBS = "                 ++ unwords (forDeps Installed.extraLibraries),
                 variablePrefix ++ "_DEP_LD_OPTS = "                    ++ unwords (forDeps Installed.ldOptions),
                 variablePrefix ++ "_BUILD_GHCI_LIB = "                 ++ boolToYesNo (withGHCiLib lbi),
@@ -387,9 +454,15 @@ generate config_args distdir directory
                 "$(eval $(" ++ directory ++ "_PACKAGE_MAGIC))"
                 ]
       writeFile (distdir ++ "/package-data.mk") $ unlines xs
-      writeFile (distdir ++ "/haddock-prologue.txt") $
+
+      writeFileUtf8 (distdir ++ "/haddock-prologue.txt") $
           if null (description pd) then synopsis pd
                                    else description pd
+      unless (null dll0Modules) $
+          do let dll0Mods = words dll0Modules
+                 dllMods = allMods \\ dll0Mods
+                 dllModSets = map unwords [dll0Mods, dllMods]
+             writeFile (distdir ++ "/dll-split") $ unlines dllModSets
   where
      escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []
      wrap = mapM wrap1
@@ -402,6 +475,11 @@ generate config_args distdir directory
       | head s == ' ' = die ["Leading space in value to be wrapped:", s]
       | last s == ' ' = die ["Trailing space in value to be wrapped:", s]
       | otherwise     = return ("\'" ++ s ++ "\'")
+     mkSearchPath = intercalate [searchPathSeparator]
      boolToYesNo True = "YES"
      boolToYesNo False = "NO"
 
+     -- | Version of 'writeFile' that always uses UTF8 encoding
+     writeFileUtf8 f txt = withFile f WriteMode $ \hdl -> do
+         hSetEncoding hdl utf8
+         hPutStr hdl txt