diff options
| author | Daniel Burrows <dburrows@debian.org> | 2009-04-07 21:30:08 -0700 |
|---|---|---|
| committer | Daniel Burrows <dburrows@debian.org> | 2009-04-07 21:30:08 -0700 |
| commit | 8ce5e820cf66dd14ab0391c17840fba19c692646 (patch) | |
| tree | c6b4d05644b9e85ee766fb52fa8c8cccc0dc1adf /tools | |
| parent | 467d410fa4d0c06e4777ae5effdb0f95182c28b7 (diff) | |
| download | aptitude-8ce5e820cf66dd14ab0391c17840fba19c692646.tar.gz | |
If parts of the graph have been cut off, show missing parents of nodes as clouds.
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/resolver-visualize/DotRender.hs | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/tools/resolver-visualize/DotRender.hs b/tools/resolver-visualize/DotRender.hs index bbc443ed..3b9b4114 100644 --- a/tools/resolver-visualize/DotRender.hs +++ b/tools/resolver-visualize/DotRender.hs @@ -3,6 +3,7 @@ module DotRender( ) where import Data.List +import Data.Maybe import Dot import Resolver.Log import Resolver.PrettyPrint @@ -74,6 +75,19 @@ dotUnprocessedSuccs params step = unprocessed ++ excluded | (Successor { successorStep = step }) <- stepSuccessors step, not $ inBounds params (stepOrder step) ] +-- | If the parent of the given step was excluded from the render, +-- build and return a node for it. +dotExcludedParent :: Params -> ProcessingStep -> Maybe Node +dotExcludedParent params step = + do (ParentLink {parentLinkParent = parentStep}) <- stepPredecessor step + (if inBounds params $ stepOrder parentStep + then fail "Not an excluded step." + else return $ + node (name $ printf "step%d" (stepOrder parentStep)) + <<< set "label" (printf "Step %d" (stepOrder step)) + <<< set "shape" "plaintext" + <<< set "image" (cloudImage params)) + dotPromotions params step = if not $ showPromotions params then [] @@ -144,7 +158,8 @@ dotEdges params step = cutIncoming ++ processed ++ unprocessed ++ promotions ++ | ParentLink { parentLinkAction = choice, parentLinkForced = forced, parentLinkParent = parentStep } - <- maybeToList $ stepPredecessor step ] + <- maybeToList $ stepPredecessor step, + not $ inBounds params $ stepOrder parentStep ] dotOrderEdges steps = [ edge (node (name $ printf "step%d" (stepOrder step1))) @@ -162,10 +177,12 @@ renderDot params steps = then error "No steps to render." else let stepNodes = map (dotStepNode params) truncatedSteps unprocessed = concat $ map (dotUnprocessedSuccs params) truncatedSteps + excludedParents = catMaybes $ map (dotExcludedParent params) truncatedSteps promotions = concat $ map (dotPromotions params) truncatedSteps stepEdges = concat $ map (dotEdges params) truncatedSteps orderEdges = dotOrderEdges truncatedSteps in - digraph (stepNodes ++ unprocessed ++ promotions) (stepEdges ++ orderEdges) + digraph (stepNodes ++ excludedParents ++ + unprocessed ++ promotions) (stepEdges ++ orderEdges) writeDotRun params steps outputFile = do let dot = renderDot params steps |