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