git.iko.soy/stackage
on master help sign in
Basic dep tree display
1833de6Michael Snoyman
Stackage/Config.hs+9
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1module Stackage.Config where
2module Stackage.Config where
2
3
3import Control.Monad (unless, when)
4import Control.Monad (unless, when)
@@ -63,3 +64,11 @@ stablePackages = execWriter $ do
63 case simpleParse range of
64 case simpleParse range of
64 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
65 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
65 Just range' -> tell $ Map.singleton (PackageName package) range'
66 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
3 , iiPackageList
3 , iiPackageList
4 ) where
4 ) where
5
5
6+import Control.Monad (when)
6import qualified Data.Map as Map
7import qualified Data.Map as Map
7import qualified Data.Set as Set
8import qualified Data.Set as Set
8import Stackage.Config
9import Stackage.Config
@@ -11,6 +12,7 @@ import Stackage.LoadDatabase
11import Stackage.NarrowDatabase
12import Stackage.NarrowDatabase
12import Stackage.Types
13import Stackage.Types
13import Stackage.Util
14import Stackage.Util
15+import Data.Version (showVersion)
14
16
15getInstallInfo :: IO InstallInfo
17getInstallInfo :: IO InstallInfo
16getInstallInfo = do
18getInstallInfo = do
@@ -19,10 +21,26 @@ getInstallInfo = do
19 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
21 let totalCore = extraCore `Set.union` Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)
20 pdb <- loadPackageDB totalCore allPackages
22 pdb <- loadPackageDB totalCore allPackages
21 final <- narrowPackageDB pdb $ Set.fromList $ Map.keys allPackages
23 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
22 return InstallInfo
28 return InstallInfo
23 { iiCore = totalCore
29 { iiCore = totalCore
24− , iiPackages = final
30+ , iiPackages = Map.map fst final
25 }
31 }
26
32
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+
27iiPackageList :: InstallInfo -> [String]
45iiPackageList :: InstallInfo -> [String]
28iiPackageList = map packageVersionString . Map.toList . iiPackages
46iiPackageList = map packageVersionString . Map.toList . iiPackages
Stackage/NarrowDatabase.hs+9−8
@@ -9,22 +9,23 @@ import Stackage.Types
9-- their dependencies.
9-- their dependencies.
10narrowPackageDB :: PackageDB
10narrowPackageDB :: PackageDB
11 -> Set PackageName
11 -> Set PackageName
12− -> IO (Map PackageName Version)
12+ -> IO (Map PackageName (Version, [PackageName]))
13narrowPackageDB (PackageDB pdb) =
13narrowPackageDB (PackageDB pdb) =
14− loop Map.empty . Set.map ((,) True)
14+ loop Map.empty . Set.map ((,) [])
15 where
15 where
16 loop result toProcess =
16 loop result toProcess =
17 case Set.minView toProcess of
17 case Set.minView toProcess of
18 Nothing -> return result
18 Nothing -> return result
19− Just ((isOrig, p), toProcess') ->
19+ Just ((users, p), toProcess') ->
20 case Map.lookup p pdb of
20 case Map.lookup p pdb of
21 Nothing
21 Nothing
22− | isOrig -> error $ "Unknown package: " ++ show p
22+ | null users -> error $ "Unknown package: " ++ show p
23 | otherwise -> loop result toProcess'
23 | otherwise -> loop result toProcess'
24 Just pi -> do
24 Just pi -> do
25+ let users' = p:users
25− let result' = Map.insert p (piVersion pi) result
26+ result' = Map.insert p (piVersion pi, users) result
26− loop result' $ Set.foldl' (addDep result') toProcess' $ piDeps pi
27+ loop result' $ Set.foldl' (addDep users' result') toProcess' $ piDeps pi
27− addDep result toProcess p =
28+ addDep users result toProcess p =
28 case Map.lookup p result of
29 case Map.lookup p result of
29− Nothing -> Set.insert (False, p) toProcess
30+ Nothing -> Set.insert (users, p) toProcess
30 Just{} -> toProcess
31 Just{} -> toProcess