git.iko.soy/stackage
on b6b1d14 help sign in
stackage/Stackage/InstallInfo.hs
116 lines 4.6 kB history raw
1module Stackage.InstallInfo
2 ( getInstallInfo
3 , iiPackageList
4 ) where
6import Control.Arrow ((&&&))
7import Control.Monad (forM_)
8import qualified Data.Map as Map
9import qualified Data.Set as Set
10import Data.Version (showVersion)
11import qualified Distribution.Text
12import Distribution.Version (withinRange, simplifyVersionRange)
13import Stackage.HaskellPlatform
14import Stackage.LoadDatabase
15import Stackage.NarrowDatabase
16import Stackage.Types
17import Stackage.Util
19dropExcluded :: BuildSettings
20 -> Map PackageName (VersionRange, Maintainer)
21 -> Map PackageName (VersionRange, Maintainer)
22dropExcluded bs m0 =
23 Set.foldl' (flip Map.delete) m0 (excludedPackages bs)
25getInstallInfo :: BuildSettings -> IO InstallInfo
26getInstallInfo settings = do
27 putStrLn "Loading Haskell Platform"
28 hp <- loadHaskellPlatform settings
29 let allPackages'
30 | requireHaskellPlatform settings = Map.union (stablePackages settings) $ identsToRanges (hplibs hp)
31 | otherwise = stablePackages settings
32 allPackages = dropExcluded settings allPackages'
33 let totalCore = extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
35 putStrLn "Loading package database"
36 pdb <- loadPackageDB settings totalCore allPackages
38 putStrLn "Narrowing package database"
39 final <- narrowPackageDB settings pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
41 putStrLn "Printing build plan to build-plan.log"
42 writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
44 case checkBadVersions settings final of
45 badVersions
46 | Map.null badVersions -> return ()
47 | otherwise -> do
48 forM_ (Map.toList badVersions) $ \(user, badDeps) -> do
49 putStrLn $ user ++ " cannot use: "
50 forM_ (Map.toList badDeps) $ \(name, (version, range)) -> do
51 putStrLn $ concat
52 [ "- "
53 , packageVersionString (name, version)
54 , " -- "
55 , Distribution.Text.display $ simplifyVersionRange range
56 ]
57 putStrLn ""
59 error "Conflicting build plan, exiting"
61 return InstallInfo
62 { iiCore = totalCore
63 , iiPackages = Map.map (biVersion &&& biMaintainer) final
64 , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
65 , iiPackageDB = pdb
66 }
68showDep :: (PackageName, BuildInfo) -> String
69showDep (PackageName name, (BuildInfo version deps (Maintainer m) _)) =
70 concat
71 [ name
72 , "-"
73 , showVersion version
74 , " ("
75 , m
76 , ")"
77 , ": "
78 , unwords $ map unP deps
79 ]
80 where
81 unP (PackageName p) = p
83iiPackageList :: InstallInfo -> [String]
84iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
86-- | Check for internal mismatches in required and actual package versions.
87checkBadVersions :: BuildSettings
88 -> Map PackageName BuildInfo
89 -> Map String (Map PackageName (Version, VersionRange))
90checkBadVersions settings buildPlan =
91 Map.unions $ map getBadVersions $ Map.toList $ Map.filterWithKey unexpectedFailure buildPlan
92 where
93 unexpectedFailure name _ = name `Set.notMember` expectedFailures settings
95 getBadVersions :: (PackageName, BuildInfo) -> Map String (Map PackageName (Version, VersionRange))
96 getBadVersions (name, bi)
97 | Map.null badVersions = Map.empty
98 | otherwise = Map.singleton display badVersions
99 where
100 badVersions = Map.unions $ map (uncurry checkPackage) $ Map.toList $ biDeps bi
101 display = concat
102 [ packageVersionString (name, biVersion bi)
103 , " ("
104 , unMaintainer $ biMaintainer bi
105 , ")"
106 ]
108 checkPackage :: PackageName -> VersionRange -> Map PackageName (Version, VersionRange)
109 checkPackage name vr =
110 case Map.lookup name buildPlan of
111 -- Can't find the dependency. Could be part of core, so just ignore
112 -- it.
113 Nothing -> Map.empty
114 Just bi
115 | biVersion bi `withinRange` vr -> Map.empty
116 | otherwise -> Map.singleton name (biVersion bi, vr)