1{-# LANGUAGE CPP, ViewPatterns #-} 2-- | Build a Gtk2hs package. 3-- 4module Gtk2HsSetup ( 5 gtk2hsUserHooks, 6 getPkgConfigPackages, 7 checkGtk2hsBuildtools, 8 typeGenProgram, 9 signalGenProgram, 10 c2hsLocal 11 ) where 12 13import Data.Maybe (mapMaybe) 14#if MIN_VERSION_Cabal(2,4,0) 15import Distribution.Pretty (prettyShow) 16#else 17import Distribution.Simple.LocalBuildInfo (getComponentLocalBuildInfo) 18#endif 19import Distribution.Simple 20import Distribution.Simple.PreProcess 21import Distribution.InstalledPackageInfo ( importDirs, 22 showInstalledPackageInfo, 23 libraryDirs, 24 extraLibraries, 25 extraGHCiLibraries ) 26import Distribution.Simple.PackageIndex ( lookupUnitId ) 27import Distribution.PackageDescription as PD ( PackageDescription(..), 28 updatePackageDescription, 29 BuildInfo(..), 30 emptyBuildInfo, allBuildInfo, 31 Library(..), 32 explicitLibModules, hasLibs) 33import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms), 34 InstallDirs(..), 35 ComponentLocalBuildInfo, 36 componentPackageDeps, 37 absoluteInstallDirs, 38 relocatable, 39 compiler) 40import Distribution.Types.LocalBuildInfo as LBI (componentNameCLBIs) 41import qualified Distribution.Types.LocalBuildInfo as LBI 42import Distribution.Simple.Compiler ( Compiler(..) ) 43import Distribution.Simple.Program ( 44 Program(..), ConfiguredProgram(..), 45 runDbProgram, getDbProgramOutput, programName, programPath, 46 c2hsProgram, pkgConfigProgram, gccProgram, requireProgram, ghcPkgProgram, 47 simpleProgram, lookupProgram, getProgramOutput, ProgArg) 48#if MIN_VERSION_Cabal(2,0,0) 49import Distribution.Simple.Program.HcPkg ( defaultRegisterOptions ) 50import Distribution.Types.PkgconfigDependency ( PkgconfigDependency(..) ) 51import Distribution.Types.PkgconfigName 52#endif 53import Distribution.ModuleName ( ModuleName, components, toFilePath ) 54import Distribution.Simple.Utils hiding (die) 55import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..), 56 defaultCopyFlags, ConfigFlags(configVerbosity), 57 fromFlag, toFlag, RegisterFlags(..), flagToMaybe, 58 fromFlagOrDefault, defaultRegisterFlags) 59#if MIN_VERSION_Cabal(2,0,0) 60import Distribution.Simple.BuildPaths ( autogenPackageModulesDir ) 61#endif 62import Distribution.Simple.Install ( install ) 63import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) 64import Distribution.Text ( simpleParse, display ) 65import System.FilePath 66import System.Exit (die, exitFailure) 67import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist ) 68import Distribution.Version (Version(..)) 69import Distribution.Verbosity 70import Control.Monad (when, unless, filterM, liftM, forM, forM_) 71import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList, catMaybes ) 72import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy, stripPrefix, tails ) 73import Data.Ord as Ord (comparing) 74import Data.Char (isAlpha, isNumber) 75import qualified Data.Map as M 76import qualified Data.Set as S 77import qualified Distribution.PackageDescription as PD 78import qualified Distribution.Simple.LocalBuildInfo as LBI 79import qualified Distribution.InstalledPackageInfo as IPI 80 (installedUnitId) 81import Distribution.Simple.Compiler (compilerVersion) 82import qualified Distribution.Compat.Graph as Graph 83 84import Control.Applicative ((<$>)) 85 86import Distribution.Simple.Program.Find ( defaultProgramSearchPath ) 87import Gtk2HsC2Hs (c2hsMain) 88import HookGenerator (hookGen) 89import TypeGen (typeGen) 90import UNames (unsafeResetRootNameSupply) 91 92#if !MIN_VERSION_Cabal(2,0,0) 93versionNumbers :: Version -> [Int] 94versionNumbers = versionBranch 95#endif 96 97onDefaultSearchPath f a b = f a b defaultProgramSearchPath 98#if MIN_VERSION_Cabal(2,5,0) 99componentsConfigs :: LocalBuildInfo -> [(LBI.ComponentName, ComponentLocalBuildInfo, [LBI.ComponentName])] 100componentsConfigs lbi = 101 [ (LBI.componentLocalName clbi, 102 clbi, 103 mapMaybe (fmap LBI.componentLocalName . flip Graph.lookup g) 104 (LBI.componentInternalDeps clbi)) 105 | clbi <- Graph.toList g ] 106 where 107 g = LBI.componentGraph lbi 108 109libraryConfig lbi = case [clbi | (LBI.CLibName _, clbi, _) <- componentsConfigs lbi] of 110#else 111libraryConfig lbi = case [clbi | (LBI.CLibName, clbi, _) <- LBI.componentsConfigs lbi] of 112#endif 113 [clbi] -> Just clbi 114 _ -> Nothing 115 116-- the name of the c2hs pre-compiled header file 117precompFile = "precompchs.bin" 118 119gtk2hsUserHooks = simpleUserHooks { 120 -- hookedPrograms is only included for backwards compatibility with older Setup.hs. 121 hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], 122 hookedPreProcessors = [("chs", ourC2hs)], 123 confHook = \pd cf -> 124 (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)), 125 postConf = \args cf pd lbi -> do 126 genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi 127 postConf simpleUserHooks args cf pd lbi, 128 buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> 129 buildHook simpleUserHooks pd lbi uh bf, 130 copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >> 131 installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), 132 instHook = \pd lbi uh flags -> 133#if defined(mingw32_HOST_OS) || defined(__MINGW32__) 134 installHook pd lbi uh flags >> 135 installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest, 136 regHook = registerHook 137#else 138 instHook simpleUserHooks pd lbi uh flags >> 139 installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest 140#endif 141 } 142 143------------------------------------------------------------------------------ 144-- Lots of stuff for windows ghci support 145------------------------------------------------------------------------------ 146 147getDlls :: [FilePath] -> IO [FilePath] 148getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$> 149 mapM getDirectoryContents dirs 150 151fixLibs :: [FilePath] -> [String] -> [String] 152fixLibs dlls = concatMap $ \ lib -> 153 case filter (isLib lib) dlls of 154 dlls@(_:_) -> [dropExtension (pickDll dlls)] 155 _ -> if lib == "z" then [] else [lib] 156 where 157 -- If there are several .dll files matching the one we're after then we 158 -- just have to guess. For example for recent Windows cairo builds we get 159 -- libcairo-2.dll libcairo-gobject-2.dll libcairo-script-interpreter-2.dll 160 -- Our heuristic is to pick the one with the shortest name. 161 -- Yes this is a hack but the proper solution is hard: we would need to 162 -- parse the .a file and see which .dll file(s) it needed to link to. 163 pickDll = minimumBy (Ord.comparing length) 164 isLib lib dll = 165 case stripPrefix ("lib"++lib) dll of 166 Just ('.':_) -> True 167 Just ('-':n:_) | isNumber n -> True 168 _ -> False 169 170-- The following code is a big copy-and-paste job from the sources of 171-- Cabal 1.8 just to be able to fix a field in the package file. Yuck. 172 173installHook :: PackageDescription -> LocalBuildInfo 174 -> UserHooks -> InstallFlags -> IO () 175installHook pkg_descr localbuildinfo _ flags = do 176 let copyFlags = defaultCopyFlags { 177 copyDistPref = installDistPref flags, 178 copyDest = toFlag NoCopyDest, 179 copyVerbosity = installVerbosity flags 180 } 181 install pkg_descr localbuildinfo copyFlags 182 let registerFlags = defaultRegisterFlags { 183 regDistPref = installDistPref flags, 184 regInPlace = installInPlace flags, 185 regPackageDB = installPackageDB flags, 186 regVerbosity = installVerbosity flags 187 } 188 when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags 189 190registerHook :: PackageDescription -> LocalBuildInfo 191 -> UserHooks -> RegisterFlags -> IO () 192registerHook pkg_descr localbuildinfo _ flags = 193 if hasLibs pkg_descr 194 then register pkg_descr localbuildinfo flags 195 else setupMessage verbosity 196 "Package contains no library to register:" (packageId pkg_descr) 197 where verbosity = fromFlag (regVerbosity flags) 198 199#if MIN_VERSION_Cabal(2,4,0) 200getComponentLocalBuildInfo :: LocalBuildInfo -> LBI.ComponentName -> ComponentLocalBuildInfo 201getComponentLocalBuildInfo lbi cname = 202 case LBI.componentNameCLBIs lbi cname of 203 [clbi] -> clbi 204 [] -> 205 error $ "internal error: there is no configuration data " 206 ++ "for component " ++ show cname 207 clbis -> 208 error $ "internal error: the component name " ++ show cname 209 ++ "is ambiguous. Refers to: " 210 ++ intercalate ", " (map (prettyShow . LBI.componentUnitId) clbis) 211#endif 212 213register :: PackageDescription -> LocalBuildInfo 214 -> RegisterFlags -- ^Install in the user's database?; verbose 215 -> IO () 216register pkg@PackageDescription { library = Just lib } lbi regFlags 217 = do 218 let clbi = getComponentLocalBuildInfo lbi 219#if MIN_VERSION_Cabal(2,5,0) 220 (LBI.CLibName $ PD.libName lib) 221#else 222 LBI.CLibName 223#endif 224 225 absPackageDBs <- absolutePackageDBPaths packageDbs 226 installedPkgInfoRaw <- generateRegistrationInfo 227 verbosity pkg lib lbi clbi inplace reloc distPref 228 (registrationPackageDB absPackageDBs) 229 230 dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls 231 let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw) 232 installedPkgInfo = installedPkgInfoRaw { 233 extraGHCiLibraries = libs } 234 235 when (fromFlag (regPrintId regFlags)) $ do 236 putStrLn (display (IPI.installedUnitId installedPkgInfo)) 237 238 -- Three different modes: 239 case () of 240 _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo 241 | modeGenerateRegScript -> die "Generate Reg Script not supported" 242 | otherwise -> do 243 setupMessage verbosity "Registering" (packageId pkg) 244 registerPackage verbosity (compiler lbi) (withPrograms lbi) 245#if MIN_VERSION_Cabal(2,0,0) 246 packageDbs installedPkgInfo defaultRegisterOptions 247#else 248 False packageDbs installedPkgInfo 249#endif 250 251 where 252 modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) 253 regFile = fromMaybe (display (packageId pkg) <.> "conf") 254 (fromFlag (regGenPkgConf regFlags)) 255 modeGenerateRegScript = fromFlag (regGenScript regFlags) 256 inplace = fromFlag (regInPlace regFlags) 257 reloc = relocatable lbi 258 packageDbs = nub $ withPackageDB lbi 259 ++ maybeToList (flagToMaybe (regPackageDB regFlags)) 260 distPref = fromFlag (regDistPref regFlags) 261 verbosity = fromFlag (regVerbosity regFlags) 262 263 writeRegistrationFile installedPkgInfo = do 264 notice verbosity ("Creating package registration file: " ++ regFile) 265 writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo) 266 267register _ _ regFlags = notice verbosity "No package to register" 268 where 269 verbosity = fromFlag (regVerbosity regFlags) 270 271 272------------------------------------------------------------------------------ 273-- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later 274------------------------------------------------------------------------------ 275 276#if MIN_VERSION_Cabal(2,0,0) 277adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo 278adjustLocalBuildInfo = id 279#else 280adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo 281adjustLocalBuildInfo lbi = 282 let extra = (Just libBi, []) 283 libBi = emptyBuildInfo { includeDirs = [ autogenPackageModulesDir lbi 284 , buildDir lbi ] } 285 in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) } 286#endif 287 288------------------------------------------------------------------------------ 289-- Processing .chs files with our local c2hs. 290------------------------------------------------------------------------------ 291 292#if MIN_VERSION_Cabal(2,0,0) 293ourC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 294ourC2hs bi lbi _ = PreProcessor { 295#else 296ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor 297ourC2hs bi lbi = PreProcessor { 298#endif 299 platformIndependent = False, 300 runPreProcessor = runC2HS bi lbi 301} 302 303runC2HS :: BuildInfo -> LocalBuildInfo -> 304 (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () 305runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do 306 -- have the header file name if we don't have the precompiled header yet 307 header <- case lookup "x-c2hs-header" (customFieldsBI bi) of 308 Just h -> return h 309 Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++ 310 "that sets the C header file to process .chs.pp files.") 311 312 -- c2hs will output files in out dir, removing any leading path of the input file. 313 -- Thus, append the dir of the input file to the output dir. 314 let (outFileDir, newOutFile) = splitFileName outFile 315 let newOutDir = outDir </> outFileDir 316 -- additional .chi files might be needed that other packages have installed; 317 -- we assume that these are installed in the same place as .hi files 318 let chiDirs = [ dir | 319 ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi), 320 dir <- maybe [] importDirs (lookupUnitId (installedPkgs lbi) ipi) ] 321 (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) 322 unsafeResetRootNameSupply 323 c2hsMain $ 324 map ("--include=" ++) (outDir:chiDirs) 325 ++ [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] 326 ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi] 327 ++ ["--output-dir=" ++ newOutDir, 328 "--output=" ++ newOutFile, 329 "--precomp=" ++ buildDir lbi </> precompFile, 330 header, inDir </> inFile] 331 return () 332 333getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] 334getCppOptions bi lbi 335 = nub $ 336 ["-I" ++ dir | dir <- PD.includeDirs bi] 337 ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] 338 339installCHI :: PackageDescription -- ^information from the .cabal file 340 -> LocalBuildInfo -- ^information from the configure step 341 -> Verbosity -> CopyDest -- ^flags sent to copy or install 342 -> IO () 343installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do 344 let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest 345 -- cannot use the recommended 'findModuleFiles' since it fails if there exists 346 -- a modules that does not have a .chi file 347 mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) 348 (PD.explicitLibModules lib) 349 350 let files = [ f | Just f <- mFiles ] 351 installOrdinaryFiles verbosity libPref files 352 353 354installCHI _ _ _ _ = return () 355 356------------------------------------------------------------------------------ 357-- Generating the type hierarchy and signal callback .hs files. 358------------------------------------------------------------------------------ 359 360genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () 361genSynthezisedFiles verb pd lbi = do 362 cPkgs <- getPkgConfigPackages verb lbi pd 363 364 let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) 365 ++customFieldsPD pd 366 typeOpts :: String -> [ProgArg] 367 typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field ++ '=':val) (words content) 368 | (field,content) <- xList, 369 tag `isPrefixOf` field, 370 field /= (tag++"file")] 371 ++ [ "--tag=" ++ tag 372#if MIN_VERSION_Cabal(2,0,0) 373 | PackageIdentifier name version <- cPkgs 374 , let major:minor:_ = versionNumbers version 375#else 376 | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs 377#endif 378 , let name' = filter isAlpha (display name) 379 , tag <- name' 380 :[ name' ++ "-" ++ show maj ++ "." ++ show d2 381 | (maj, d2) <- [(maj, d2) | maj <- [0..(major-1)], d2 <- [0,2..20]] 382 ++ [(major, d2) | d2 <- [0,2..minor]] ] 383 ] 384 385 signalsOpts :: [ProgArg] 386 signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content) 387 | (field,content) <- xList, 388 "x-signals-" `isPrefixOf` field, 389 field /= "x-signals-file"] 390 391 genFile :: ([String] -> IO String) -> [ProgArg] -> FilePath -> IO () 392 genFile prog args outFile = do 393 res <- prog args 394 rewriteFileEx verb outFile res 395 396 forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ 397 \(fileTag, f) -> do 398 let tag = reverse (drop 4 (reverse fileTag)) 399 info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") 400 genFile typeGen (typeOpts tag) f 401 402 case lookup "x-signals-file" xList of 403 Nothing -> return () 404 Just f -> do 405 info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") 406 genFile hookGen signalsOpts f 407 408 writeFile "gtk2hs_macros.h" $ generateMacros cPkgs 409 410-- Based on Cabal/Distribution/Simple/Build/Macros.hs 411generateMacros :: [PackageId] -> String 412generateMacros cPkgs = concat $ 413 "/* DO NOT EDIT: This file is automatically generated by Gtk2HsSetup.hs */\n\n" : 414 [ concat 415 ["/* package ",display pkgid," */\n" 416 ,"#define VERSION_",pkgname," ",show (display version),"\n" 417 ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n" 418 ," (major1) < ",major1," || \\\n" 419 ," (major1) == ",major1," && (major2) < ",major2," || \\\n" 420 ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" 421 ,"\n\n" 422 ] 423 | pkgid@(PackageIdentifier name version) <- cPkgs 424 , let (major1:major2:minor:_) = map show (versionNumbers version ++ repeat 0) 425 pkgname = map fixchar (display name) 426 ] 427 where fixchar '-' = '_' 428 fixchar '.' = '_' 429 fixchar c = c 430 431--FIXME: Cabal should tell us the selected pkg-config package versions in the 432-- LocalBuildInfo or equivalent. 433-- In the mean time, ask pkg-config again. 434 435getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId] 436getPkgConfigPackages verbosity lbi pkg = 437 sequence 438 [ do version <- pkgconfig ["--modversion", display pkgname] 439 case simpleParse version of 440 Nothing -> die "parsing output of pkg-config --modversion failed" 441#if MIN_VERSION_Cabal(2,0,0) 442 Just v -> return (PackageIdentifier (mkPackageName $ unPkgconfigName pkgname) v) 443 | PkgconfigDependency pkgname _ 444#else 445 Just v -> return (PackageIdentifier pkgname v) 446 | Dependency pkgname _ 447#endif 448 <- concatMap pkgconfigDepends (allBuildInfo pkg) ] 449 where 450 pkgconfig = getDbProgramOutput verbosity 451 pkgConfigProgram (withPrograms lbi) 452 453------------------------------------------------------------------------------ 454-- Dependency calculation amongst .chs files. 455------------------------------------------------------------------------------ 456 457-- Given all files of the package, find those that end in .chs and extract the 458-- .chs files they depend upon. Then return the PackageDescription with these 459-- files rearranged so that they are built in a sequence that files that are 460-- needed by other files are built first. 461fixDeps :: PackageDescription -> IO PackageDescription 462fixDeps pd@PD.PackageDescription { 463 PD.library = Just lib@PD.Library { 464 PD.exposedModules = expMods, 465 PD.libBuildInfo = bi@PD.BuildInfo { 466 PD.hsSourceDirs = srcDirs, 467 PD.otherModules = othMods 468 }}} = do 469 let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs 470 (joinPath (components m)) 471 mExpFiles <- mapM findModule expMods 472 mOthFiles <- mapM findModule othMods 473 474 -- tag all exposed files with True so we throw an error if we need to build 475 -- an exposed module before an internal modules (we cannot express this) 476 let modDeps = zipWith (ModDep True []) expMods mExpFiles++ 477 zipWith (ModDep False []) othMods mOthFiles 478 modDeps <- mapM extractDeps modDeps 479 let (othMods, expMods) = span (not . mdExposed) $ reverse $ sortTopological modDeps 480 return pd { PD.library = Just lib { 481 PD.exposedModules = map mdOriginal (reverse expMods), 482 PD.libBuildInfo = bi { PD.otherModules = map mdOriginal (reverse othMods) } 483 }} 484 485data ModDep = ModDep { 486 mdExposed :: Bool, 487 mdRequires :: [ModuleName], 488 mdOriginal :: ModuleName, 489 mdLocation :: Maybe FilePath 490} 491 492instance Show ModDep where 493 show x = show (mdLocation x) 494 495instance Eq ModDep where 496 ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2 497instance Ord ModDep where 498 compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2 499 500-- Extract the dependencies of this file. This is intentionally rather naive as it 501-- ignores CPP conditionals. We just require everything which means that the 502-- existance of a .chs module may not depend on some CPP condition. 503extractDeps :: ModDep -> IO ModDep 504extractDeps md@ModDep { mdLocation = Nothing } = return md 505extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do 506 let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of 507 ('i':'m':'p':'o':'r':'t':' ':ys) -> 508 case simpleParse (takeWhile ('#' /=) ys) of 509 Just m -> findImports (m:acc) xxs 510 Nothing -> die ("cannot parse chs import in "++f++":\n"++ 511 "offending line is {#"++xs) 512 -- no more imports after the first non-import hook 513 _ -> return acc 514 findImports acc (_:xxs) = findImports acc xxs 515 findImports acc [] = return acc 516 mods <- findImports [] (lines con) 517 return md { mdRequires = mods } 518 519-- Find a total order of the set of modules that are partially sorted by their 520-- dependencies on each other. The function returns the sorted list of modules 521-- together with a list of modules that are required but not supplied by this 522-- in the input set of modules. 523sortTopological :: [ModDep] -> [ModDep] 524sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms) 525 where 526 set = M.fromList (map (\m -> (mdOriginal m, m)) ms) 527 visit (out,visited) m 528 | m `S.member` visited = (out,visited) 529 | otherwise = case m `M.lookup` set of 530 Nothing -> (out, m `S.insert` visited) 531 Just md -> (md:out', visited') 532 where 533 (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) 534 535-- Included for backwards compatibility with older Setup.hs. 536checkGtk2hsBuildtools :: [Program] -> IO () 537checkGtk2hsBuildtools programs = do 538 programInfos <- mapM (\ prog -> do 539 location <- onDefaultSearchPath programFindLocation prog normal 540 return (programName prog, location) 541 ) programs 542 let printError name = do 543 putStrLn $ "Cannot find " ++ name ++ "\n" 544 ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." 545 exitFailure 546 forM_ programInfos $ \ (name, location) -> 547 when (isNothing location) (printError name) 548 549-- Included for backwards compatibility with older Setup.hs. 550typeGenProgram :: Program 551typeGenProgram = simpleProgram "gtk2hsTypeGen" 552 553-- Included for backwards compatibility with older Setup.hs. 554signalGenProgram :: Program 555signalGenProgram = simpleProgram "gtk2hsHookGenerator" 556 557-- Included for backwards compatibility with older Setup.hs. 558-- We are not going to use this, so reporting the version we will use 559c2hsLocal :: Program 560c2hsLocal = (simpleProgram "gtk2hsC2hs") { 561 programFindVersion = \_ _ -> return . Just $ 562#if MIN_VERSION_Cabal(2,0,0) 563 mkVersion [0,13,13] 564#else 565 Version [0,13,13] [] 566#endif 567 } 568