mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 23:38:29 +01:00
151 lines
6.2 KiB
Diff
151 lines
6.2 KiB
Diff
diff -ru orig/Gtk2HsSetup.hs new/Gtk2HsSetup.hs
|
|
--- orig/Gtk2HsSetup.hs 2013-10-28 08:36:50.283581635 +0100
|
|
+++ new/Gtk2HsSetup.hs 2013-10-28 08:36:50.000000000 +0100
|
|
@@ -1,4 +1,4 @@
|
|
-{-# LANGUAGE CPP #-}
|
|
+{-# LANGUAGE CPP, ViewPatterns #-}
|
|
|
|
#ifndef CABAL_VERSION_CHECK
|
|
#error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file
|
|
@@ -29,7 +29,7 @@
|
|
emptyBuildInfo, allBuildInfo,
|
|
Library(..),
|
|
libModules, hasLibs)
|
|
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),
|
|
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms),
|
|
InstallDirs(..),
|
|
componentPackageDeps,
|
|
absoluteInstallDirs)
|
|
@@ -56,14 +56,26 @@
|
|
import Distribution.Verbosity
|
|
import Control.Monad (when, unless, filterM, liftM, forM, forM_)
|
|
import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList )
|
|
-import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy)
|
|
+import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy, stripPrefix)
|
|
import Data.Ord as Ord (comparing)
|
|
-import Data.Char (isAlpha)
|
|
+import Data.Char (isAlpha, isNumber)
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
+import qualified Distribution.Simple.LocalBuildInfo as LBI
|
|
|
|
import Control.Applicative ((<$>))
|
|
|
|
+#if CABAL_VERSION_CHECK(1,17,0)
|
|
+import Distribution.Simple.Program.Find ( defaultProgramSearchPath )
|
|
+onDefaultSearchPath f a b = f a b defaultProgramSearchPath
|
|
+libraryConfig lbi = case [clbi | (LBI.CLibName, clbi, _) <- LBI.componentsConfigs lbi] of
|
|
+ [clbi] -> Just clbi
|
|
+ _ -> Nothing
|
|
+#else
|
|
+onDefaultSearchPath = id
|
|
+libraryConfig = LBI.libraryConfig
|
|
+#endif
|
|
+
|
|
-- the name of the c2hs pre-compiled header file
|
|
precompFile = "precompchs.bin"
|
|
|
|
@@ -100,7 +112,7 @@
|
|
|
|
fixLibs :: [FilePath] -> [String] -> [String]
|
|
fixLibs dlls = concatMap $ \ lib ->
|
|
- case filter (("lib" ++ lib) `isPrefixOf`) dlls of
|
|
+ case filter (isLib lib) dlls of
|
|
dlls@(_:_) -> [dropExtension (pickDll dlls)]
|
|
_ -> if lib == "z" then [] else [lib]
|
|
where
|
|
@@ -111,7 +123,12 @@
|
|
-- Yes this is a hack but the proper solution is hard: we would need to
|
|
-- parse the .a file and see which .dll file(s) it needed to link to.
|
|
pickDll = minimumBy (Ord.comparing length)
|
|
-
|
|
+ isLib lib dll =
|
|
+ case stripPrefix ("lib"++lib) dll of
|
|
+ Just ('.':_) -> True
|
|
+ Just ('-':n:_) | isNumber n -> True
|
|
+ _ -> False
|
|
+
|
|
-- The following code is a big copy-and-paste job from the sources of
|
|
-- Cabal 1.8 just to be able to fix a field in the package file. Yuck.
|
|
|
|
@@ -144,8 +161,8 @@
|
|
register :: PackageDescription -> LocalBuildInfo
|
|
-> RegisterFlags -- ^Install in the user's database?; verbose
|
|
-> IO ()
|
|
-register pkg@PackageDescription { library = Just lib }
|
|
- lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags
|
|
+register pkg@(library -> Just lib )
|
|
+ lbi@(libraryConfig -> Just clbi) regFlags
|
|
= do
|
|
|
|
installedPkgInfoRaw <- generateRegistrationInfo
|
|
@@ -237,6 +254,7 @@
|
|
= nub $
|
|
["-I" ++ dir | dir <- PD.includeDirs bi]
|
|
++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"]
|
|
+ ++ ["-D__GLASGOW_HASKELL__="++show __GLASGOW_HASKELL__]
|
|
|
|
installCHI :: PackageDescription -- ^information from the .cabal file
|
|
-> LocalBuildInfo -- ^information from the configure step
|
|
@@ -426,7 +444,7 @@
|
|
checkGtk2hsBuildtools :: [Program] -> IO ()
|
|
checkGtk2hsBuildtools programs = do
|
|
programInfos <- mapM (\ prog -> do
|
|
- location <- programFindLocation prog normal
|
|
+ location <- onDefaultSearchPath programFindLocation prog normal
|
|
return (programName prog, location)
|
|
) programs
|
|
let printError name = do
|
|
diff -ru orig/SetupWrapper.hs new/SetupWrapper.hs
|
|
--- orig/SetupWrapper.hs 2013-10-28 08:36:50.283581635 +0100
|
|
+++ new/SetupWrapper.hs 2013-10-28 08:36:50.000000000 +0100
|
|
@@ -29,6 +29,24 @@
|
|
import Control.Monad
|
|
|
|
|
|
+-- moreRecentFile is implemented in Distribution.Simple.Utils, but only in
|
|
+-- Cabal >= 1.18. For backwards-compatibility, we implement a copy with a new
|
|
+-- name here. Some desirable alternate strategies don't work:
|
|
+-- * We can't use CPP to check which version of Cabal we're up against because
|
|
+-- this is the file that's generating the macros for doing that.
|
|
+-- * We can't use the name moreRecentFiles and use
|
|
+-- import D.S.U hiding (moreRecentFiles)
|
|
+-- because on old GHC's (and according to the Report) hiding a name that
|
|
+-- doesn't exist is an error.
|
|
+moreRecentFile' :: FilePath -> FilePath -> IO Bool
|
|
+moreRecentFile' a b = do
|
|
+ exists <- doesFileExist b
|
|
+ if not exists
|
|
+ then return True
|
|
+ else do tb <- getModificationTime b
|
|
+ ta <- getModificationTime a
|
|
+ return (ta > tb)
|
|
+
|
|
setupWrapper :: FilePath -> IO ()
|
|
setupWrapper setupHsFile = do
|
|
args <- getArgs
|
|
@@ -91,8 +109,8 @@
|
|
-- Currently this is GHC only. It should really be generalised.
|
|
--
|
|
compileSetupExecutable = do
|
|
- setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile
|
|
- cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile
|
|
+ setupHsNewer <- setupHsFile `moreRecentFile'` setupProgFile
|
|
+ cabalVersionNewer <- setupVersionFile `moreRecentFile'` setupProgFile
|
|
let outOfDate = setupHsNewer || cabalVersionNewer
|
|
when outOfDate $ do
|
|
debug verbosity "Setup script is out of date, compiling..."
|
|
@@ -144,12 +162,3 @@
|
|
Nothing Nothing Nothing
|
|
exitCode <- waitForProcess process
|
|
unless (exitCode == ExitSuccess) $ exitWith exitCode
|
|
-
|
|
-moreRecentFile :: FilePath -> FilePath -> IO Bool
|
|
-moreRecentFile a b = do
|
|
- exists <- doesFileExist b
|
|
- if not exists
|
|
- then return True
|
|
- else do tb <- getModificationTime b
|
|
- ta <- getModificationTime a
|
|
- return (ta > tb)
|