Commit f7fbf11b authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add PackageIndex.dependencyGraph that builds a Graph

Useful for some more tricky queries.
parent 5bc5fb7f
...@@ -44,6 +44,7 @@ module Distribution.Simple.PackageIndex ( ...@@ -44,6 +44,7 @@ module Distribution.Simple.PackageIndex (
dependencyClosure, dependencyClosure,
dependencyInconsistencies, dependencyInconsistencies,
dependencyCycles, dependencyCycles,
dependencyGraph,
) where ) where
import Prelude hiding (lookup) import Prelude hiding (lookup)
...@@ -51,6 +52,8 @@ import Control.Exception (assert) ...@@ -51,6 +52,8 @@ import Control.Exception (assert)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Graph as Graph import qualified Data.Graph as Graph
import qualified Data.Array as Array
import Data.Array ((!))
import Data.List (nubBy, group, sort, groupBy, sortBy, find) import Data.List (nubBy, group, sort, groupBy, sortBy, find)
import Data.Monoid (Monoid(..)) import Data.Monoid (Monoid(..))
import Data.Maybe (isNothing) import Data.Maybe (isNothing)
...@@ -329,3 +332,34 @@ dependencyCycles index = ...@@ -329,3 +332,34 @@ dependencyCycles index =
where where
adjacencyList = [ (pkg, packageId pkg, depends pkg) adjacencyList = [ (pkg, packageId pkg, depends pkg)
| pkg <- allPackages index ] | pkg <- allPackages index ]
-- | Builds a graph of the package dependencies.
--
-- Dependencies on other packages that are in the index are discarded.
-- You can check if there are any such dependencies with 'brokenPackages'.
--
dependencyGraph :: PackageFixedDeps pkg
=> PackageIndex pkg
-> (Graph.Graph,
Graph.Vertex -> PackageIdentifier,
PackageIdentifier -> Maybe Graph.Vertex)
dependencyGraph index = (graph, vertexToPkgId, pkgIdToVertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map pkgIdToVertex (depends pkg) ]
| pkg <- pkgs ]
vertexToPkgId vertex = pkgIdTable ! vertex
pkgIdToVertex = binarySearch 0 topBound
pkgIdTable = Array.listArray bounds (map packageId pkgs)
pkgs = sortBy (comparing packageId) (allPackages index)
topBound = length pkgs - 1
bounds = (0, topBound)
binarySearch a b key
| a > b = Nothing
| otherwise = case compare key (pkgIdTable ! mid) of
LT -> binarySearch a (mid-1) key
EQ -> Just mid
GT -> binarySearch (mid+1) b key
where mid = (a + b) `div` 2
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment