Cabal.hs 1.85 KB
Newer Older
1
2
3
4
5
module Rules.Cabal (cabalRules) where

import Base
import Util
import Stage
6
7
import Package hiding (pkgName, library)
import Expression hiding (package)
8
9
10
import Settings.Packages
import Data.List
import Data.Version
11
12
13
14
import Distribution.Package
import Distribution.Verbosity
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
15
16

cabalRules :: Rules ()
17
cabalRules = do
18
19
20
21
22
23
    -- Cache boot package constraints (to be used in cabalArgs)
    bootPackageConstraints %> \file -> do
        pkgs <- interpret (stageTarget Stage0) packages
        constraints <- forM (sort pkgs) $ \pkg -> do
            let cabal = pkgPath pkg -/- pkgCabal pkg
            need [cabal]
24
25
26
27
            description <- liftIO $ readPackageDescription silent cabal
            let identifier       = package . packageDescription $ description
                version          = showVersion . pkgVersion $ identifier
                PackageName name = pkgName identifier
28
29
            return $ name ++ " == " ++ version
        writeFileChanged file . unlines $ constraints
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

    -- Cache package dependencies
    packageDependencies %> \file -> do
        pkgs <- interpret (stageTarget Stage1) packages
        pkgDeps <- forM (sort pkgs) $ \pkg -> do
            let cabal = pkgPath pkg -/- pkgCabal pkg
            need [cabal]
            description <- liftIO $ readPackageDescription silent cabal
            let deps     = collectDeps . condLibrary $ description
                depNames = [ name | Dependency (PackageName name) _ <- deps ]
            return . unwords $ (dropExtension $ pkgCabal pkg) : sort depNames
        writeFileChanged file $ unlines pkgDeps

collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
collectDeps Nothing = []
collectDeps (Just (CondNode _ deps ifs)) = deps ++ concatMap f ifs
  where
    f (_, t, mt) = collectDeps (Just t) ++ collectDeps mt