diff --git a/Cabal.cabal b/Cabal.cabal
index 686f946c52fed5dbc690cf00d97f9ae4809e59ee..9eea8a56bf8bd7ce9173e196d621a5b05e303996 100644
--- a/Cabal.cabal
+++ b/Cabal.cabal
@@ -70,6 +70,7 @@ Library {
Distribution.Simple.SetupWrapper,
Distribution.Simple.SrcDist,
Distribution.Simple.Utils,
+ Distribution.System,
Distribution.Verbosity,
Distribution.Version,
Distribution.Compat.ReadP,
diff --git a/Distribution/Program.hs b/Distribution/Program.hs
index 6b3afe15c06d9eb2993c706e41846bcc9d39eade..8fcd11625191ee91c26113bc25305b0f349c2669 100644
--- a/Distribution/Program.hs
+++ b/Distribution/Program.hs
@@ -71,6 +71,7 @@ module Distribution.Program(
import qualified Distribution.Compat.Map as Map
import Distribution.Compat.Directory (findExecutable)
import Distribution.Simple.Utils (die, rawSystemExit, rawSystemStdout)
+import Distribution.System
import Distribution.Version (Version, readVersion)
import Distribution.Verbosity
import System.Directory (doesFileExist)
@@ -261,11 +262,11 @@ greencardProgram :: Program
greencardProgram = simpleProgram "greencard"
ldProgram :: Program
-#if defined(mingw32_TARGET_OS) || defined(mingw32_HOST_OS)
-ldProgram = Program "ld" "ld" [] (FoundOnSystem "<what-your-hs-compiler-shipped-with>")
-#else
-ldProgram = simpleProgram "ld"
-#endif
+ldProgram = case os of
+ Windows MingW ->
+ Program "ld" "ld" Nothing []
+ (FoundOnSystem "<what-your-hs-compiler-shipped-with>")
+ _ -> simpleProgram "ld"
tarProgram :: Program
tarProgram = simpleProgram "tar"
diff --git a/Distribution/Simple/Build.hs b/Distribution/Simple/Build.hs
index 0607bbcaf0a40124d247e10568b83b88560c2646..ce3761932f51c8f92d9a1a9ed10d7fd1e46bebe7 100644
--- a/Distribution/Simple/Build.hs
+++ b/Distribution/Simple/Build.hs
@@ -65,6 +65,7 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Configure
( localBuildInfoFile )
import Distribution.Simple.Utils( createDirectoryIfMissingVerbose, die )
+import Distribution.System
import System.FilePath ( (</>), pathSeparator )
@@ -242,11 +243,14 @@ buildPathsModule pkg_descr lbi =
mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel
mkGetDir dir Nothing = "return " ++ show dir
-#if mingw32_HOST_OS
- absolute = hasLibs pkg_descr || flat_bindirrel == Nothing
-#else
- absolute = hasLibs pkg_descr || flat_progdirrel == Nothing || not isHugs
-#endif
+ absolute = case os of
+ Windows MingW ->
+ hasLibs pkg_descr ||
+ flat_bindirrel == Nothing
+ _ ->
+ hasLibs pkg_descr ||
+ flat_progdirrel == Nothing ||
+ not isHugs
paths_modulename = autogenModuleName pkg_descr
paths_filename = paths_modulename ++ ".hs"
@@ -319,18 +323,14 @@ filename_stuff =
" _ -> path1\n"++
"\n"++
"pathSeparator :: Char\n"++
-#if mingw32_HOST_OS
- "pathSeparator = '\\\\'\n"++
-#else
- "pathSeparator = '/'\n"++
-#endif
+ (case os of
+ Windows _ -> "pathSeparator = '\\\\'\n"
+ _ -> "pathSeparator = '/'\n") ++
"\n"++
"isPathSeparator :: Char -> Bool\n"++
-#if mingw32_HOST_OS
- "isPathSeparator c = c == '/' || c == '\\\\'\n"
-#else
- "isPathSeparator c = c == '/'\n"
-#endif
+ (case os of
+ Windows _ -> "isPathSeparator c = c == '/' || c == '\\\\'\n"
+ _ -> "isPathSeparator c = c == '/'\n")
-- ------------------------------------------------------------
-- * Testing
diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs
index fca822df9fe4d14ab7dfa3c4605ebcfba790e801..8460ed844a26d9ff59d465e44c3e755c18b63d04 100644
--- a/Distribution/Simple/Configure.hs
+++ b/Distribution/Simple/Configure.hs
@@ -67,6 +67,7 @@ module Distribution.Simple.Configure (configure,
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Register (removeInstalledConfig)
import Distribution.Setup(ConfigFlags(..), CopyDest(..))
+import Distribution.System
import Distribution.Compiler(CompilerFlavor(..), Compiler(..),
compilerVersion, compilerPath, compilerPkgToolPath,
extensionsToFlags)
@@ -78,7 +79,7 @@ import Distribution.PackageDescription(
finalizePackageDescription,
HookedBuildInfo, sanityCheckPackage, updatePackageDescription,
BuildInfo(..), Executable(..), setupMessage,
- satisfyDependency)
+ satisfyDependency, hasLibs)
import Distribution.Simple.Utils (die, warn, rawSystemStdout)
import Distribution.Version (Version(..), Dependency(..), VersionRange(ThisVersion),
showVersion, showVersionRange)
@@ -113,10 +114,6 @@ import Distribution.Compat.ReadP
import Distribution.Compat.Directory (createDirectoryIfMissing)
import Prelude hiding (catch)
-#ifdef mingw32_HOST_OS
-import Distribution.PackageDescription (hasLibs)
-#endif
-
#ifdef DEBUG
import Test.HUnit
#endif
@@ -316,23 +313,15 @@ messageDir :: PackageDescription -> LocalBuildInfo -> String
-> (PackageDescription -> LocalBuildInfo -> CopyDest -> FilePath)
-> (PackageDescription -> LocalBuildInfo -> CopyDest -> Maybe FilePath)
-> IO ()
-messageDir pkg_descr lbi name mkDir
-#if mingw32_HOST_OS
- mkDirRel
-#else
- _
-#endif
+messageDir pkg_descr lbi name mkDir mkDirRel
= message (name ++ " installed in: " ++ mkDir pkg_descr lbi NoCopyDest ++ rel_note)
where
-#if mingw32_HOST_OS
- rel_note
- | not (hasLibs pkg_descr) &&
- mkDirRel pkg_descr lbi NoCopyDest == Nothing
- = " (fixed location)"
- | otherwise = ""
-#else
- rel_note = ""
-#endif
+ rel_note = case os of
+ Windows MingW
+ | not (hasLibs pkg_descr) &&
+ mkDirRel pkg_descr lbi NoCopyDest == Nothing
+ -> " (fixed location)"
+ _ -> ""
-- |Converts build dependencies to a versioned dependency. only sets
-- version information for exact versioned dependencies.
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
index 8f285477566c15b745443a48130dd80242515e3b..5cb5cf9424e9c1f8ca44d067a8d667dc05ebefbe 100644
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -76,6 +76,7 @@ import Distribution.Version ( Version(..) )
import qualified Distribution.Simple.GHCPackageConfig as GHC
( localPackageConfig,
canReadLocalPackageConfig )
+import Distribution.System
import Distribution.Verbosity
import Language.Haskell.Extension (Extension(..))
@@ -271,14 +272,11 @@ build pkg_descr lbi verbosity = do
runAr = rawSystemProgramConf verbosity "ar" (withPrograms lbi)
-#if defined(mingw32_TARGET_OS) || defined(mingw32_HOST_OS)
- rawSystemLd = rawSystemExit
- maxCommandLineSize = 30 * 1024
-#else
- rawSystemLd = rawSystemPathExit
+ rawSystemLd = case os of
+ Windows MingW -> rawSystemExit
+ _ -> rawSystemPathExit
--TODO: discover this at configure time on unix
maxCommandLineSize = 30 * 1024
-#endif
ifVanillaLib False $ xargs maxCommandLineSize
runAr arArgs arObjArgs
@@ -430,22 +428,18 @@ mkGHCiLibName pref lib = pref </> ("HS" ++ lib) <.> ".o"
findLdProgram :: LocalBuildInfo -> IO FilePath
-#if defined(mingw32_TARGET_OS) || defined(mingw32_HOST_OS)
-findLdProgram lbi =
- let
- compilerDir = takeDirectory $ compilerPath (compiler lbi)
- baseDir = takeDirectory compilerDir
- binInstallLd = baseDir </> "gcc-lib" </> "ld.exe"
- in do
- mb <- lookupProgram "ld" (withPrograms lbi)
- case fmap programLocation mb of
- Just (UserSpecified s) -> return s
- -- assume we're using an installed copy of GHC..
- _ -> return binInstallLd
-#else
-findLdProgram _ =
- return "ld"
-#endif
+findLdProgram lbi
+ = case os of
+ Windows MingW ->
+ do let compilerDir = takeDirectory $ compilerPath (compiler lbi)
+ baseDir = takeDirectory compilerDir
+ binInstallLd = baseDir </> "gcc-lib" </> "ld.exe"
+ mb <- lookupProgram "ld" (withPrograms lbi)
+ case fmap programLocation mb of
+ Just (UserSpecified s) -> return s
+ -- assume we're using an installed copy of GHC..
+ _ -> return binInstallLd
+ _ -> return "ld"
-- -----------------------------------------------------------------------------
-- Building a Makefile
diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs
index 26cf11cb211e8da2e3458342c2f26c067ac86244..925227cfa3dc94360f8b3c11b2dc78e559c7acb0 100644
--- a/Distribution/Simple/Hugs.hs
+++ b/Distribution/Simple/Hugs.hs
@@ -66,6 +66,7 @@ import Distribution.Compat.Directory
( copyFile, removeDirectoryRecursive )
import System.FilePath ( (</>), takeExtension, (<.>),
searchPathSeparator, normalise, takeDirectory )
+import Distribution.System
import Distribution.Verbosity
import Distribution.Package ( PackageIdentifier(..) )
@@ -343,17 +344,18 @@ install verbosity libDir installProgDir binDir targetProgDir buildPref pkg_descr
-- FIX (HUGS): use extensions, and options from file too?
-- see http://hackage.haskell.org/trac/hackage/ticket/43
let hugsOptions = hcOptions Hugs (options (buildInfo exe))
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- let exeFile = binDir </> exeName exe <.> ".bat"
- let script = unlines [
- "@echo off",
- unwords ("runhugs" : hugsOptions ++ [targetName, "%*"])]
-#else
- let exeFile = binDir </> exeName exe
- let script = unlines [
- "#! /bin/sh",
- unwords ("runhugs" : hugsOptions ++ [targetName, "\"$@\""])]
-#endif
+ let exeFile = case os of
+ Windows _ -> binDir </> exeName exe <.> ".bat"
+ _ -> binDir </> exeName exe
+ let script = case os of
+ Windows _ ->
+ let args = hugsOptions ++ [targetName, "%*"]
+ in unlines ["@echo off",
+ unwords ("runhugs" : args)]
+ _ ->
+ let args = hugsOptions ++ [targetName, "\"$@\""]
+ in unlines ["#! /bin/sh",
+ unwords ("runhugs" : args)]
writeFile exeFile script
perms <- getPermissions exeFile
setPermissions exeFile perms { executable = True, readable = True }
diff --git a/Distribution/Simple/LocalBuildInfo.hs b/Distribution/Simple/LocalBuildInfo.hs
index 9cbab211a13d55d8580d7491dab21b678b84aead..f53bd1b2033de473d725f91d364489dfce109db4 100644
--- a/Distribution/Simple/LocalBuildInfo.hs
+++ b/Distribution/Simple/LocalBuildInfo.hs
@@ -73,6 +73,7 @@ import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Compiler (Compiler(..), CompilerFlavor(..), showCompilerId)
import Distribution.Setup (CopyDest(..))
+import Distribution.System
import Distribution.Version (showVersion)
import System.FilePath
#if mingw32_HOST_OS || mingw32_TARGET_OS
@@ -222,35 +223,29 @@ foreign import stdcall unsafe "shlobj.h SHGetFolderPathA"
#endif
default_bindir :: FilePath
-default_bindir = "$prefix" </>
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- "Haskell" </> "bin"
-#else
- "bin"
-#endif
+default_bindir = "$prefix" </> path
+ where path = case os of
+ Windows _ -> "Haskell" </> "bin"
+ _ -> "bin"
default_libdir :: Compiler -> FilePath
-default_libdir _ = "$prefix" </>
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- "Haskell"
-#else
- "lib"
-#endif
+default_libdir _ = "$prefix" </> path
+ where path = case os of
+ Windows _ -> "Haskell"
+ _ -> "lib"
default_libsubdir :: Compiler -> FilePath
default_libsubdir hc =
case compilerFlavor hc of
- Hugs -> "hugs" </> "packages" </> "$pkg"
+ Hugs -> "hugs" </> "packages" </> "$pkg"
JHC -> "$compiler"
- _ -> "$pkgid" </> "$compiler"
+ _ -> "$pkgid" </> "$compiler"
default_libexecdir :: FilePath
-default_libexecdir = "$prefix" </>
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- "$pkgid"
-#else
- "libexec"
-#endif
+default_libexecdir = "$prefix" </> path
+ where path = case os of
+ Windows _ -> "$pkgid"
+ _ -> "libexec"
default_datadir :: PackageDescription -> IO FilePath
#if mingw32_HOST_OS || mingw32_TARGET_OS
@@ -333,18 +328,7 @@ absolutePath pkg_descr lbi copydest s =
case copydest of
NoCopyDest -> substDir (package pkg_descr) lbi s
CopyPrefix d -> substDir (package pkg_descr) lbi{prefix=d} s
- CopyTo p -> p </> (dropAbsolutePrefix (substDir (package pkg_descr) lbi s))
- where
- -- | If the function is applied to an absolute path then it returns a local path droping
- -- the absolute prefix in the path. Under Windows the prefix is \"\\\", \"c:\" or \"c:\\\". Under
- -- Unix the prefix is always \"\/\".
- dropAbsolutePrefix :: FilePath -> FilePath
- dropAbsolutePrefix (c:cs) | isPathSeparator c = cs
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- dropAbsolutePrefix (_:':':c:cs) | isPathSeparator c = cs -- path with drive letter
- dropAbsolutePrefix (_:':':cs) = cs
-#endif
- dropAbsolutePrefix cs = cs
+ CopyTo p -> p </> (dropDrive (substDir (package pkg_descr) lbi s))
substDir :: PackageIdentifier -> LocalBuildInfo -> String -> String
substDir pkgId lbi xs = loop xs
diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs
index 02b097d95364d465946f25e065fb539d928732af..1293b9a9b5a26ce31ff5f79692c2025a1280e2c7 100644
--- a/Distribution/Simple/Register.hs
+++ b/Distribution/Simple/Register.hs
@@ -81,6 +81,7 @@ import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
import Distribution.Simple.GHCPackageConfig (mkGHCPackageConfig, showGHCPackageConfig)
import qualified Distribution.Simple.GHCPackageConfig
as GHC (localPackageConfig, canWriteLocalPackageConfig, maybeCreateLocalPackageConfig)
+import Distribution.System
import Distribution.Compat.Directory
(removeDirectoryRecursive,
setPermissions, getPermissions, Permissions(executable)
@@ -100,18 +101,14 @@ import Test.HUnit (Test)
#endif
regScriptLocation :: FilePath
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-regScriptLocation = "register.bat"
-#else
-regScriptLocation = "register.sh"
-#endif
+regScriptLocation = case os of
+ Windows _ -> "register.bat"
+ _ -> "register.sh"
unregScriptLocation :: FilePath
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-unregScriptLocation = "unregister.bat"
-#else
-unregScriptLocation = "unregister.sh"
-#endif
+unregScriptLocation = case os of
+ Windows _ -> "unregister.bat"
+ _ -> "unregister.sh"
-- -----------------------------------------------------------------------------
-- Registration
@@ -165,23 +162,19 @@ register pkg_descr lbi regFlags
putStrLn ("create " ++ instConf)
writeInstalledConfig pkg_descr lbi inplace (Just instConf)
- let register_flags
- | ghc_63_plus = "update":
-#if !(mingw32_HOST_OS || mingw32_TARGET_OS)
- if genScript
- then []
- else
-#endif
- [instConf]
- | otherwise = "--update-package":
-#if !(mingw32_HOST_OS || mingw32_TARGET_OS)
- if genScript
- then []
- else
-#endif
- ["--input-file="++instConf]
-
- let allFlags = register_flags
+ let register_flags
+ | ghc_63_plus = let conf = case os of
+ Windows MingW
+ | genScript -> []
+ _ -> [instConf]
+ in "update" : conf
+ | otherwise = let conf = case os of
+ Windows MingW
+ | genScript -> []
+ _ -> ["--input-file="++instConf]
+ in "--update-package" : conf
+
+ let allFlags = register_flags
++ config_flags
++ if ghc_63_plus && genScript then ["-"] else []
let pkgTool = compilerPkgToolPath hc
@@ -374,16 +367,15 @@ rawSystemEmit :: FilePath -- ^Script name
-> IO ()
rawSystemEmit _ False verbosity path args
= rawSystemExit verbosity path args
-rawSystemEmit scriptName True _ path args = do
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- writeFile scriptName ("@" ++ path ++ concatMap (' ':) args)
-#else
- writeFile scriptName ("#!/bin/sh\n\n"
- ++ (path ++ concatMap (' ':) args)
- ++ "\n")
- p <- getPermissions scriptName
- setPermissions scriptName p{executable=True}
-#endif
+rawSystemEmit scriptName True _ path args
+ = case os of
+ Windows _ ->
+ writeFile scriptName ("@" ++ path ++ concatMap (' ':) args)
+ _ -> do writeFile scriptName ("#!/bin/sh\n\n"
+ ++ (path ++ concatMap (' ':) args)
+ ++ "\n")
+ p <- getPermissions scriptName
+ setPermissions scriptName p{executable=True}
-- |Like rawSystemEmit, except it has string for pipeFrom. FIX: chmod +x
rawSystemPipe :: FilePath -- ^Script location
@@ -392,18 +384,17 @@ rawSystemPipe :: FilePath -- ^Script location
-> FilePath -- ^Program to run
-> [String] -- ^Args
-> IO ()
-rawSystemPipe scriptName _ pipeFrom path args = do
-#if mingw32_HOST_OS || mingw32_TARGET_OS
- writeFile scriptName ("@" ++ path ++ concatMap (' ':) args)
-#else
- writeFile scriptName ("#!/bin/sh\n\n"
- ++ "echo '" ++ escapeForShell pipeFrom
- ++ "' | "
- ++ (path ++ concatMap (' ':) args)
- ++ "\n")
- p <- getPermissions scriptName
- setPermissions scriptName p{executable=True}
-#endif
+rawSystemPipe scriptName _ pipeFrom path args
+ = case os of
+ Windows _ ->
+ writeFile scriptName ("@" ++ path ++ concatMap (' ':) args)
+ _ -> do writeFile scriptName ("#!/bin/sh\n\n"
+ ++ "echo '" ++ escapeForShell pipeFrom
+ ++ "' | "
+ ++ (path ++ concatMap (' ':) args)
+ ++ "\n")
+ p <- getPermissions scriptName
+ setPermissions scriptName p{executable=True}
where escapeForShell [] = []
escapeForShell ('\'':cs) = "'\\''" ++ escapeForShell cs
escapeForShell (c :cs) = c : escapeForShell cs
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
index 53b0b7b4f01b34beca2c53b4d70b25791565a26e..43495ccf6d0bb7d212c29462a860ed012528e29b 100644
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -84,6 +84,7 @@ module Distribution.Simple.Utils (
import Distribution.Compat.RawSystem (rawSystem)
import Distribution.Compat.Exception (bracket)
+import Distribution.System
#if __GLASGOW_HASKELL__ >= 604
import Control.Exception (evaluate)
@@ -470,11 +471,9 @@ findHookedPackageDesc dir = do
-- | Extension for executable files
-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
exeExtension :: String
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-exeExtension = "exe"
-#else
-exeExtension = ""
-#endif
+exeExtension = case os of
+ Windows _ -> "exe"
+ _ -> ""
-- ToDo: This should be determined via autoconf (AC_OBJEXT)
-- | Extension for object files. For GHC and NHC the extension is @\"o\"@.
@@ -485,12 +484,9 @@ objExtension = "o"
-- | Extension for dynamically linked (or shared) libraries
-- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
dllExtension :: String
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-dllExtension = "dll"
-#else
-dllExtension = "so"
-#endif
-
+dllExtension = case os of
+ Windows _ -> "dll"
+ _ -> "so"
-- ------------------------------------------------------------
-- * Testing
diff --git a/Distribution/System.hs b/Distribution/System.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a382aaef9281182f6a2fddc10e5f94644d6acbc4
--- /dev/null
+++ b/Distribution/System.hs
@@ -0,0 +1,16 @@
+
+module Distribution.System where
+
+data OS = Linux | Windows Windows | Other String
+data Windows = MingW
+
+os :: OS
+os =
+#if defined(linux_HOST_OS)
+ Linux
+#elif defined(mingw32_HOST_OS)
+ Windows MingW
+#else
+ Other System.Info.os
+#endif
+