Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
53277279
Commit
53277279
authored
Aug 05, 2007
by
Ian Lynagh
Browse files
Pattern match on an OS datatype rather than using ifdef everywhere
parent
8742ba8e
Changes
10
Hide whitespace changes
Inline
Side-by-side
Cabal.cabal
View file @
53277279
...
...
@@ -70,6 +70,7 @@ Library {
Distribution.Simple.SetupWrapper,
Distribution.Simple.SrcDist,
Distribution.Simple.Utils,
Distribution.System,
Distribution.Verbosity,
Distribution.Version,
Distribution.Compat.ReadP,
...
...
Distribution/Program.hs
View file @
53277279
...
...
@@ -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
=
si
mple
Program
"ld"
#
endif
ldProgram
=
case
os
of
Windows
MingW
->
Program
"ld"
"ld"
Nothing
[]
(
FoundOnSystem
"<what-your-hs-co
mp
i
le
r-shipped-with>"
)
_
->
simpleProgram
"ld"
tarProgram
::
Program
tarProgram
=
simpleProgram
"tar"
...
...
Distribution/Simple/Build.hs
View file @
53277279
...
...
@@ -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
...
...
Distribution/Simple/Configure.hs
View file @
53277279
...
...
@@ -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.
...
...
Distribution/Simple/GHC.hs
View file @
53277279
...
...
@@ -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
...
...
Distribution/Simple/Hugs.hs
View file @
53277279
...
...
@@ -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
}
...
...
Distribution/Simple/LocalBuildInfo.hs
View file @
53277279
...
...
@@ -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
...
...
Distribution/Simple/Register.hs
View file @
53277279
...
...
@@ -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
...
...
Distribution/Simple/Utils.hs
View file @
53277279
...
...
@@ -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
...
...
Distribution/System.hs
0 → 100644
View file @
53277279
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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment