From b339b31f4842f6501be2418756cfbb60d57b2b6c Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@haskell.org>
Date: Tue, 6 May 2008 23:43:26 +0000
Subject: [PATCH] Add PackageIndex.dependencyGraph that builds a Graph Useful
 for some more tricky queries.

---
 Distribution/Simple/PackageIndex.hs | 34 +++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs
index c45285fc80..eebb2cf2b3 100644
--- a/Distribution/Simple/PackageIndex.hs
+++ b/Distribution/Simple/PackageIndex.hs
@@ -44,6 +44,7 @@ module Distribution.Simple.PackageIndex (
   dependencyClosure,
   dependencyInconsistencies,
   dependencyCycles,
+  dependencyGraph,
   ) where
 
 import Prelude hiding (lookup)
@@ -51,6 +52,8 @@ import Control.Exception (assert)
 import qualified Data.Map as Map
 import Data.Map (Map)
 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.Monoid (Monoid(..))
 import Data.Maybe (isNothing)
@@ -329,3 +332,34 @@ dependencyCycles index =
   where
     adjacencyList = [ (pkg, packageId pkg, depends pkg)
                     | 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
-- 
GitLab