aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockModuleTree.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaddockModuleTree.hs')
-rw-r--r--src/HaddockModuleTree.hs32
1 files changed, 19 insertions, 13 deletions
diff --git a/src/HaddockModuleTree.hs b/src/HaddockModuleTree.hs
index 93f0f162..f052bd69 100644
--- a/src/HaddockModuleTree.hs
+++ b/src/HaddockModuleTree.hs
@@ -2,22 +2,28 @@ module HaddockModuleTree(ModuleTree(..), mkModuleTree) where
import HsSyn
-data ModuleTree = Node String Bool [ModuleTree]
+data ModuleTree = Node String Bool (Maybe String) [ModuleTree]
-mkModuleTree :: [Module] -> [ModuleTree]
-mkModuleTree mods = foldr addToTrees [] (map splitModule mods)
+mkModuleTree :: [(Module,Maybe String)] -> [ModuleTree]
+mkModuleTree mods =
+ foldr fn [] [ (splitModule mod, pkg) | (mod,pkg) <- mods ]
+ where
+ fn (mod,pkg) trees = addToTrees mod pkg trees
-addToTrees :: [String] -> [ModuleTree] -> [ModuleTree]
-addToTrees [] ts = ts
-addToTrees ss [] = mkSubTree ss
-addToTrees (s1:ss) (t@(Node s2 leaf subs) : ts)
- | s1 > s2 = t : addToTrees (s1:ss) ts
- | s1 == s2 = Node s2 (leaf || null ss) (addToTrees ss subs) : ts
- | otherwise = mkSubTree (s1:ss) ++ t : ts
+addToTrees :: [String] -> Maybe String -> [ModuleTree] -> [ModuleTree]
+addToTrees [] pkg ts = ts
+addToTrees ss pkg [] = mkSubTree ss pkg
+addToTrees (s1:ss) pkg (t@(Node s2 leaf node_pkg subs) : ts)
+ | s1 > s2 = t : addToTrees (s1:ss) pkg ts
+ | s1 == s2 = Node s2 (leaf || null ss) this_pkg (addToTrees ss pkg subs) : ts
+ | otherwise = mkSubTree (s1:ss) pkg ++ t : ts
+ where
+ this_pkg = if null ss then pkg else node_pkg
-mkSubTree :: [String] -> [ModuleTree]
-mkSubTree [] = []
-mkSubTree (s:ss) = [Node s (null ss) (mkSubTree ss)]
+mkSubTree :: [String] -> Maybe String -> [ModuleTree]
+mkSubTree [] pkg = []
+mkSubTree [s] pkg = [Node s True pkg []]
+mkSubTree (s:ss) pkg = [Node s (null ss) Nothing (mkSubTree ss pkg)]
splitModule :: Module -> [String]
splitModule (Module mdl) = split mdl