aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/ModuleTree.hs
blob: f3008d755ea00260071192980869c9c08142e2f6 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.ModuleTree
-- Copyright   :  (c) Simon Marlow 2003-2006,
--                    David Waern  2006
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
-----------------------------------------------------------------------------
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 ]
  where
    modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_))
                | 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
addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts)
  | s1 >  s2  = t : addToTrees (s1:ss) pkg short ts
  | s1 == s2  = Node s2 (leaf || null ss) this_pkg this_short (addToTrees ss pkg short subs) : ts
  | otherwise = mkSubTree (s1:ss) pkg short ++ t : ts
 where
  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
     			(s1, '.':s2) -> s1 : split s2
     			(s1, _)      -> [s1]