diff options
| -rw-r--r-- | src/Haddock/ModuleTree.hs | 6 |
1 files changed, 6 insertions, 0 deletions
diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs index f3008d75..61812e3a 100644 --- a/src/Haddock/ModuleTree.hs +++ b/src/Haddock/ModuleTree.hs @@ -11,14 +11,17 @@ ----------------------------------------------------------------------------- module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where + import Haddock.Types ( Doc ) import GHC ( Name ) import Module ( Module, moduleNameString, moduleName, modulePackageId, packageIdString ) + data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree] + mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree] mkModuleTree showPkgs mods = foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ] @@ -27,6 +30,7 @@ mkModuleTree showPkgs mods = | otherwise = Nothing fn (mod_,pkg,short) = addToTrees mod_ pkg short + addToTrees :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] -> [ModuleTree] addToTrees [] _ _ ts = ts addToTrees ss pkg short [] = mkSubTree ss pkg short @@ -38,11 +42,13 @@ addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) this_pkg = if null ss then pkg else node_pkg this_short = if null ss then short else node_short + mkSubTree :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] mkSubTree [] _ _ = [] mkSubTree [s] pkg short = [Node s True pkg short []] mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)] + splitModule :: Module -> [String] splitModule mdl = split (moduleNameString (moduleName mdl)) where split mod0 = case break (== '.') mod0 of |