From 7ebf189e9356ad404d079c4e4251c08c051d0fe0 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Wed, 3 Aug 2016 23:58:41 +0000 Subject: [PATCH] More compact buildTree impl using foldr --- src/Data/Graph/DirectedAcyclic/View/Tree.hs | 22 ++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/Data/Graph/DirectedAcyclic/View/Tree.hs b/src/Data/Graph/DirectedAcyclic/View/Tree.hs index 3bce816..083ab0f 100644 --- a/src/Data/Graph/DirectedAcyclic/View/Tree.hs +++ b/src/Data/Graph/DirectedAcyclic/View/Tree.hs @@ -106,12 +106,20 @@ mkGraph nodeMap edges = keySet :: HashMap k v -> HashSet k keySet = S.fromMap . M.map (const ()) +-- | Traverse a graph DFS-style and build a tree recording the traversal. +-- +-- The code looks like a simple fold, because the edge labels are the ones +-- responsible for limiting the recursion into a tree structure. +-- +-- The graph should have at most one full out-edge per node, and\/or have no +-- cycles, otherwise this function isn't guaranteed to stop. buildTree :: (Eq n, Hashable n) => [(n, Maybe b)] -> Graph n a (Maybe b) -> [DagViewTree a (a, b)] -buildTree nodes graph = go nodes +buildTree nodes graph = -- go nodes + {- where go [] = [] go ((n, full) : ps) = @@ -126,6 +134,18 @@ buildTree nodes graph = go nodes Just info -> let ts = go ps in LinkNode (fst c, info) : ts + -} + + let f (n, full) ts = + case M.lookup n graph of + Nothing -> ts + Just c -> + let t = case full of + Nothing -> FullNode (fst c) (go $ snd c) + Just info -> LinkNode (fst c, info) + in t : ts + go = foldr f [] + in go nodes dagViewTree :: (Eq n, Ord n, Hashable n)