git.iko.soy/stackage
on master help sign in
Basic dep tree display
commit1833de64b800485de84a916331eb7265f7936b3b authorMichael Snoyman <michael@snoyman.com> dateFri 23 Nov 2012, 11:07 (14 years ago) parentd8571ea
3 files changed+37−9
compare with master
unifiedsplit
Stackage/Config.hs+9 Stackage/InstallInfo.hs+19−1 Stackage/NarrowDatabase.hs+9−8
Stackage/Config.hs+9
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12module Stackage.Config where
23
34import Control.Monad (unless, when)
@@ -63,3 +64,11 @@ stablePackages = execWriter $ do
6364 case simpleParse range of
6465 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
6566 Just range' -> tell $ Map.singleton (PackageName package) range'
67+
68+verbose :: Bool
69+verbose =
70+#if VERBOSE
71+ True
72+#else
73+ False
74+#endif
Stackage/InstallInfo.hs+19−1
@@ -3,6 +3,7 @@ module Stackage.InstallInfo
33 , iiPackageList
44 ) where
55
6+import Control.Monad (when)
67import qualified Data.Map as Map
78import qualified Data.Set as Set
89import Stackage.Config
@@ -11,6 +12,7 @@ import Stackage.LoadDatabase
1112import Stackage.NarrowDatabase
1213import Stackage.Types
1314import Stackage.Util
15+import Data.Version (showVersion)
1416
1517getInstallInfo :: IO InstallInfo
1618getInstallInfo = do
@@ -19,10 +21,26 @@ getInstallInfo = do
1921 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
2022 pdb <- loadPackageDB totalCore allPackages
2123 final <- narrowPackageDB pdb $ Set.fromList $ Map.keys allPackages
24+
25+ when verbose $ do
26+ putStrLn "Basic dependency listing:"
27+ mapM_ (putStrLn . showDep) $ Map.toList final
2228 return InstallInfo
2329 { iiCore = totalCore
24− , iiPackages = final
30+ , iiPackages = Map.map fst final
2531 }
2632
33+showDep :: (PackageName, (Version, [PackageName])) -> String
34+showDep (name, (version, deps)) =
35+ concat
36+ [ unP name
37+ , "-"
38+ , showVersion version
39+ , ": "
40+ , unwords $ map unP deps
41+ ]
42+ where
43+ unP (PackageName p) = p
44+
2745iiPackageList :: InstallInfo -> [String]
2846iiPackageList = map packageVersionString . Map.toList . iiPackages
Stackage/NarrowDatabase.hs+9−8
@@ -9,22 +9,23 @@ import Stackage.Types
99-- their dependencies.
1010narrowPackageDB :: PackageDB
1111 -> Set PackageName
12− -> IO (Map PackageName Version)
12+ -> IO (Map PackageName (Version, [PackageName]))
1313narrowPackageDB (PackageDB pdb) =
14− loop Map.empty . Set.map ((,) True)
14+ loop Map.empty . Set.map ((,) [])
1515 where
1616 loop result toProcess =
1717 case Set.minView toProcess of
1818 Nothing -> return result
19− Just ((isOrig, p), toProcess') ->
19+ Just ((users, p), toProcess') ->
2020 case Map.lookup p pdb of
2121 Nothing
22− | isOrig -> error $ "Unknown package: " ++ show p
22+ | null users -> error $ "Unknown package: " ++ show p
2323 | otherwise -> loop result toProcess'
2424 Just pi -> do
25− let result' = Map.insert p (piVersion pi) result
26− loop result' $ Set.foldl' (addDep result') toProcess' $ piDeps pi
27− addDep result toProcess p =
25+ let users' = p:users
26+ result' = Map.insert p (piVersion pi, users) result
27+ loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi
28+ addDep users result toProcess p =
2829 case Map.lookup p result of
29− Nothing -> Set.insert (False, p) toProcess
30+ Nothing -> Set.insert (users, p) toProcess
3031 Just{} -> toProcess