Menu
▾
▴
[Gtk2hs-commit] (main branch): Adapt Hamish's Windows patch to support the renaming of Setup.hs to Gtk2HsSetup.hs which broke for pango.
|
From: Axel S. <si...@co...> - 2010-05-20 06:38:29
|
diffing dir...
Sun May 16 10:07:08 EDT 2010 Axe...@in...
* Adapt Hamish's Windows patch to support the renaming of Setup.hs to Gtk2HsSetup.hs which broke for pango.
Ignore-this: 242a375c16d531d6c08268fac074c154
{
hunk ./pango/Gtk2HsSetup.hs 39
-import Distribution.InstalledPackageInfo ( importDirs )
+import Distribution.InstalledPackageInfo ( importDirs,
+ showInstalledPackageInfo,
+ libraryDirs,
+ extraLibraries,
+ extraGHCiLibraries )
hunk ./pango/Gtk2HsSetup.hs 56
- libModules)
+ libModules, hasLibs)
hunk ./pango/Gtk2HsSetup.hs 67
- Program(..), ConfiguredProgram(..),
+ Program(..), ConfiguredProgram(..), lhcPkgProgram,
hunk ./pango/Gtk2HsSetup.hs 69
- c2hsProgram, pkgConfigProgram,
+ c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,
hunk ./pango/Gtk2HsSetup.hs 75
- fromFlag, toFlag)
+ fromFlag, toFlag, RegisterFlags(..), flagToMaybe,
+ defaultRegisterFlags)
hunk ./pango/Gtk2HsSetup.hs 78
+import Distribution.Simple.Install ( install )
+import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )
hunk ./pango/Gtk2HsSetup.hs 85
-import Control.Monad (unless)
-import Data.Maybe (fromMaybe)
+import Control.Monad (when, unless, filterM)
+import Data.Maybe ( isJust, fromMaybe, maybeToList )
hunk ./pango/Gtk2HsSetup.hs 92
+import Control.Applicative ((<$>))
+import System.Directory (getDirectoryContents, doesDirectoryExist)
hunk ./pango/Gtk2HsSetup.hs 110
- instHook = \pd lbi uh flags -> (instHook simpleUserHooks) pd lbi uh flags >>
- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest
+ instHook = \pd lbi uh flags -> installHook pd lbi uh flags >>
+ installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest,
+ regHook = registerHook
hunk ./pango/Gtk2HsSetup.hs 115
+-- Lots of stuff for windows ghci support
+getDlls :: [FilePath] -> IO [FilePath]
+getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$>
+ mapM getDirectoryContents dirs
+
+fixLibs :: [FilePath] -> [String] -> [String]
+fixLibs dlls = concatMap $ \ lib ->
+ case filter (("lib" ++ lib) `isPrefixOf`) dlls of
+ dll:_ -> [dropExtension dll]
+ _ -> if lib == "z" then [] else [lib]
+
+installHook :: PackageDescription -> LocalBuildInfo
+ -> UserHooks -> InstallFlags -> IO ()
+installHook pkg_descr localbuildinfo _ flags = do
+ let copyFlags = defaultCopyFlags {
+ copyDistPref = installDistPref flags,
+ copyDest = toFlag NoCopyDest,
+ copyVerbosity = installVerbosity flags
+ }
+ install pkg_descr localbuildinfo copyFlags
+ let registerFlags = defaultRegisterFlags {
+ regDistPref = installDistPref flags,
+ regInPlace = installInPlace flags,
+ regPackageDB = installPackageDB flags,
+ regVerbosity = installVerbosity flags
+ }
+ when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags
+
+registerHook :: PackageDescription -> LocalBuildInfo
+ -> UserHooks -> RegisterFlags -> IO ()
+registerHook pkg_descr localbuildinfo _ flags =
+ if hasLibs pkg_descr
+ then register pkg_descr localbuildinfo flags
+ else setupMessage verbosity
+ "Package contains no library to register:" (packageId pkg_descr)
+ where verbosity = fromFlag (regVerbosity flags)
+
+register :: PackageDescription -> LocalBuildInfo
+ -> RegisterFlags -- ^Install in the user's database?; verbose
+ -> IO ()
+register pkg@PackageDescription { library = Just lib }
+ lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags
+ = do
+
+ installedPkgInfoRaw <- generateRegistrationInfo
+ verbosity pkg lib lbi clbi inplace distPref
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+ dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls
+ let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw)
+ installedPkgInfo = installedPkgInfoRaw {
+ extraGHCiLibraries = libs }
+#else
+ let installedPkgInfo = installedPkgInfoRaw
+#endif
+
+ -- Three different modes:
+ case () of
+ _ | modeGenerateRegFile -> die "Generate Reg File not supported"
+ | modeGenerateRegScript -> die "Generate Reg Script not supported"
+ | otherwise -> registerPackage verbosity
+ installedPkgInfo pkg lbi inplace packageDb
+
+ where
+ modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
+ modeGenerateRegScript = fromFlag (regGenScript regFlags)
+ inplace = fromFlag (regInPlace regFlags)
+ packageDb = case flagToMaybe (regPackageDB regFlags) of
+ Just db -> db
+ Nothing -> registrationPackageDB (withPackageDB lbi)
+ distPref = fromFlag (regDistPref regFlags)
+ verbosity = fromFlag (regVerbosity regFlags)
+
+register _ _ regFlags = notice verbosity "No package to register"
+ where
+ verbosity = fromFlag (regVerbosity regFlags)
+
hunk ./pango/Setup.hs 1
-{-# LANGUAGE CPP #-}
-
-#define CABAL_VERSION_ENCODE(major, minor, micro) ( \
- ((major) * 10000) \
- + ((minor) * 100) \
- + ((micro) * 1))
-
-#define CABAL_VERSION_CHECK(major,minor,micro) \
- (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))
-
--- now, this is bad, but Cabal doesn't seem to actually pass any information about
--- its version to CPP, so guess the version depending on the version of GHC
-#ifdef CABAL_VERSION_MINOR
-#ifndef CABAL_VERSION_MAJOR
-#define CABAL_VERSION_MAJOR 1
-#endif
-#ifndef CABAL_VERSION_MICRO
-#define CABAL_VERSION_MICRO 0
-#endif
-#define CABAL_VERSION CABAL_VERSION_ENCODE( \
- CABAL_VERSION_MAJOR, \
- CABAL_VERSION_MINOR, \
- CABAL_VERSION_MICRO)
-#else
-#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)
-#if (__GLASGOW_HASKELL__ >= 612)
-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)
-#else
-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)
-#endif
-#endif
-
--- | Build a Gtk2hs package.
---
-import Distribution.Simple
-import Distribution.Simple.PreProcess
-import Distribution.InstalledPackageInfo ( importDirs )
-import Distribution.Simple.PackageIndex (
-#if CABAL_VERSION_CHECK(1,8,0)
- lookupInstalledPackageId
-#else
- lookupPackageId
-#endif
- )
-import Distribution.Package ( PackageId(..) )
-import Distribution.PackageDescription as PD ( PackageDescription(..),
- updatePackageDescription,
- BuildInfo(..),
- emptyBuildInfo, allBuildInfo,
- Library(..),
- libModules)
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),
- InstallDirs(..),
-#if CABAL_VERSION_CHECK(1,8,0)
- componentPackageDeps,
-#else
- packageDeps,
-#endif
- absoluteInstallDirs)
-import Distribution.Simple.Compiler ( Compiler(..) )
-import Distribution.Simple.Program (
- Program(..), ConfiguredProgram(..),
- rawSystemProgramConf, rawSystemProgramStdoutConf,
- c2hsProgram, pkgConfigProgram,
- simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg)
-import Distribution.ModuleName ( ModuleName, components, toFilePath )
-import Distribution.Simple.Utils
-import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..),
- defaultCopyFlags, ConfigFlags(configVerbosity),
- fromFlag, toFlag)
+-- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,
+-- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept
+-- identical across all modules.
+import Distribution.Simple ( defaultMainWithHooks, UserHooks(postConf),
+ PackageIdentifier(..), PackageName(..) )
+import Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages )
+import Distribution.Simple.Setup ( ConfigFlags(configVerbosity), fromFlag)
+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
hunk ./pango/Setup.hs 10
-import Distribution.Text ( simpleParse, display )
-import System.FilePath
-import System.Directory ( doesFileExist )
-import Distribution.Version (Version(..))
+import Distribution.Text ( display )
+import Distribution.Version ( Version(..) )
hunk ./pango/Setup.hs 13
-import Control.Monad (unless)
-import Data.Maybe (fromMaybe)
-import Data.List (isPrefixOf, nub)
-import Data.Char (isAlpha)
-import qualified Data.Map as M
-import qualified Data.Set as S
-
+import Distribution.Simple.Utils
+import System.FilePath
hunk ./pango/Setup.hs 19
- genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi
- postConf simpleUserHooks args cf pd lbi,
- buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd ->
- (buildHook simpleUserHooks) pd lbi uh bf,
- copyHook = \pd lbi uh flags -> (copyHook simpleUserHooks) pd lbi uh flags >>
- installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)),
- instHook = \pd lbi uh flags -> (instHook simpleUserHooks) pd lbi uh flags >>
- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest
+ let verb = (fromFlag (configVerbosity cf))
+ cPkgs <- getPkgConfigPackages verb lbi pd
+ let [pangoVersion] = [ v | PackageIdentifier (PackageName "pango") v <- cPkgs ]
+ writePangoVersionHeaderFile verb lbi pangoVersion
+ postConf gtk2hsUserHooks args cf pd lbi
hunk ./pango/Setup.hs 26
--- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later
-adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo
-adjustLocalBuildInfo lbi =
- let extra = (Just libBi, [])
- libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi
- , buildDir lbi ] }
- in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) }
-
-ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
-ourC2hs bi lbi = PreProcessor {
- platformIndependent = False,
- runPreProcessor = runC2HS bi lbi
-}
-
-runC2HS :: BuildInfo -> LocalBuildInfo ->
- (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()
-runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do
- -- have the header file name if we don't have the precompiled header yet
- header <- case lookup "x-c2hs-header" (customFieldsBI bi) of
- Just h -> return h
- Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++
- "that sets the C header file to process .chs.pp files.")
-
- -- c2hs will output files in out dir, removing any leading path of the input file.
- -- Thus, append the dir of the input file to the output dir.
- let (outFileDir, newOutFile) = splitFileName outFile
- let newOutDir = outDir </> outFileDir
- -- additional .chi files might be needed that other packages have installed;
- -- we assume that these are installed in the same place as .hi files
- let chiDirs = [ dir |
-#if CABAL_VERSION_CHECK(1,8,0)
- ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),
- dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]
-#else
- ipi <- packageDeps lbi,
- dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]
-#endif
- rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $
- map ("--include=" ++) (outDir:chiDirs)
- ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]
- ++ ["--output-dir=" ++ newOutDir,
- "--output=" ++ newOutFile,
- "--precomp=" ++ buildDir lbi </> precompFile,
- header, inDir </> inFile]
-
-getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
-getCppOptions bi lbi
- = nub $
- ["-I" ++ dir | dir <- PD.includeDirs bi]
- ++ [opt | opt@('-':c:_) <- (PD.cppOptions bi ++ PD.ccOptions bi), c `elem` "DIU"]
-
-installCHI :: PackageDescription -- ^information from the .cabal file
- -> LocalBuildInfo -- ^information from the configure step
- -> Verbosity -> CopyDest -- ^flags sent to copy or install
- -> IO ()
-installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do
- let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest
- -- cannot use the recommended 'findModuleFiles' since it fails if there exists
- -- a modules that does not have a .chi file
- mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi])
- (map toFilePath
-#if CABAL_VERSION_CHECK(1,8,0)
- (PD.libModules lib)
-#else
- (PD.libModules pkg)
-#endif
- )
- let files = [ f | Just f <- mFiles ]
-#if CABAL_VERSION_CHECK(1,8,0)
- installOrdinaryFiles verbosity libPref files
-#else
- copyFiles verbosity libPref files
-#endif
-
- [_$_]
-installCHI _ _ _ _ = return ()
-
-------------------------------------------------------------------------------
--- Generating the type hierarchy and signal callback .hs files.
-------------------------------------------------------------------------------
-
-typeGenProgram :: Program
-typeGenProgram = (simpleProgram "gtk2hsTypeGen")
-
-signalGenProgram :: Program
-signalGenProgram = (simpleProgram "gtk2hsHookGenerator")
-
-c2hsLocal :: Program
-c2hsLocal = (simpleProgram "gtk2hsC2hs")
-
-genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-genSynthezisedFiles verb pd lbi = do
-
- cPkgs <- getPkgConfigPackages verb lbi pd
-
- let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd)
- ++customFieldsPD pd
- typeOpts :: [ProgArg]
- typeOpts = concat [ map (\val -> '-':'-':drop 8 field++'=':val) (words content)
- | (field,content) <- xList,
- "x-types-" `isPrefixOf` field,
- field /= "x-types-file"]
- ++ [ "--tag=" ++ tag
- | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs
- , let name' = filter isAlpha (display name)
- , tag <- name'
- : [ name' ++ "-" ++ show major ++ "." ++ show digit
- | digit <- [0,2..minor] ]
- ]
-
- genFile :: Program -> [ProgArg] -> FilePath -> IO ()
- genFile prog args outFile = do
- res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args
- rewriteFile outFile res
-
- case lookup "x-types-file" xList of
- Nothing -> return ()
- Just f -> do
- info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.")
- genFile typeGenProgram typeOpts f
-
- case (lookup "x-signals-file" xList,
- lookup "x-signals-modname" xList) of
- (Just _, Nothing) -> die "You need to specify the module name (X-Signals-ModName) \
- \to generate a signal file."
- (Just f, Just mod) -> do
- info verb ("Ensuring that callback hooks in "++f++" are up-to-date.")
- genFile signalGenProgram [mod] f
- (_,_) -> return ()
-
- let [pangoVersion] = [ v | PackageIdentifier (PackageName "pango") v <- cPkgs ]
- writePangoVersionHeaderFile verb lbi pangoVersion
-
---FIXME: Cabal should tell us the selected pkg-config package versions in the
--- LocalBuildInfo or equivalent.
--- In the mean time, ask pkg-config again.
-
-getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId]
-getPkgConfigPackages verbosity lbi pkg =
- sequence
- [ do version <- pkgconfig ["--modversion", display pkgname]
- case simpleParse version of
- Nothing -> die $ "parsing output of pkg-config --modversion failed"
- Just v -> return (PackageIdentifier pkgname v)
- | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ]
- where
- pkgconfig = rawSystemProgramStdoutConf verbosity
- pkgConfigProgram (withPrograms lbi)
-
}
|
