-----------------------------------------------------------------------------
-- |
-- 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 ( MDoc )

import GHC           ( Name )
import Module        ( Module, moduleNameString, moduleName, moduleUnitId, unitIdString )
import DynFlags      ( DynFlags )
import Packages      ( lookupPackage )
import PackageConfig ( sourcePackageIdString )

import qualified Control.Applicative as A


data ModuleTree = Node String (Maybe Module) (Maybe String) (Maybe String) (Maybe (MDoc Name)) [ModuleTree]


mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree DynFlags
dflags Bool
showPkgs [(Module, Maybe (MDoc Name))]
mods =
  ((Module, [String], Maybe String, Maybe String, Maybe (MDoc Name))
 -> [ModuleTree] -> [ModuleTree])
-> [ModuleTree]
-> [(Module, [String], Maybe String, Maybe String,
     Maybe (MDoc Name))]
-> [ModuleTree]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Module, [String], Maybe String, Maybe String, Maybe (MDoc Name))
-> [ModuleTree] -> [ModuleTree]
fn [] [ (Module
mdl, Module -> [String]
splitModule Module
mdl, Module -> Maybe String
modPkg Module
mdl, Module -> Maybe String
modSrcPkg Module
mdl, Maybe (MDoc Name)
short) | (Module
mdl, Maybe (MDoc Name)
short) <- [(Module, Maybe (MDoc Name))]
mods ]
  where
    modPkg :: Module -> Maybe String
modPkg Module
mod_ | Bool
showPkgs = String -> Maybe String
forall a. a -> Maybe a
Just (UnitId -> String
unitIdString (Module -> UnitId
moduleUnitId Module
mod_))
                | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
    modSrcPkg :: Module -> Maybe String
modSrcPkg Module
mod_ | Bool
showPkgs = (PackageConfig -> String) -> Maybe PackageConfig -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageConfig -> String
sourcePackageIdString
                                     (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags (Module -> UnitId
moduleUnitId Module
mod_))
                   | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
    fn :: (Module, [String], Maybe String, Maybe String, Maybe (MDoc Name))
-> [ModuleTree] -> [ModuleTree]
fn (Module
m,[String]
mod_,Maybe String
pkg,Maybe String
srcPkg,Maybe (MDoc Name)
short) = [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> [ModuleTree]
addToTrees [String]
mod_ Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short


addToTrees :: [String] -> Module -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree] -> [ModuleTree]
addToTrees :: [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> [ModuleTree]
addToTrees [] Module
_ Maybe String
_ Maybe String
_ Maybe (MDoc Name)
_ [ModuleTree]
ts = [ModuleTree]
ts
addToTrees [String]
ss Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short [] = [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
mkSubTree [String]
ss Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short
addToTrees (String
s1:[String]
ss) Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short (t :: ModuleTree
t@(Node String
s2 Maybe Module
leaf Maybe String
node_pkg Maybe String
node_srcPkg Maybe (MDoc Name)
node_short [ModuleTree]
subs) : [ModuleTree]
ts)
  | String
s1 String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>  String
s2  = ModuleTree
t ModuleTree -> [ModuleTree] -> [ModuleTree]
forall a. a -> [a] -> [a]
: [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> [ModuleTree]
addToTrees (String
s1String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short [ModuleTree]
ts
  | String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s2  = String
-> Maybe Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> ModuleTree
Node String
s2 (Maybe Module
leaf Maybe Module -> Maybe Module -> Maybe Module
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
A.<|> (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss then Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m else Maybe Module
forall a. Maybe a
Nothing)) Maybe String
this_pkg Maybe String
this_srcPkg Maybe (MDoc Name)
this_short ([String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> [ModuleTree]
addToTrees [String]
ss Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short [ModuleTree]
subs) ModuleTree -> [ModuleTree] -> [ModuleTree]
forall a. a -> [a] -> [a]
: [ModuleTree]
ts
  | Bool
otherwise = [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
mkSubTree (String
s1String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short [ModuleTree] -> [ModuleTree] -> [ModuleTree]
forall a. [a] -> [a] -> [a]
++ ModuleTree
t ModuleTree -> [ModuleTree] -> [ModuleTree]
forall a. a -> [a] -> [a]
: [ModuleTree]
ts
 where
  this_pkg :: Maybe String
this_pkg = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss then Maybe String
pkg else Maybe String
node_pkg
  this_srcPkg :: Maybe String
this_srcPkg = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss then Maybe String
srcPkg else Maybe String
node_srcPkg
  this_short :: Maybe (MDoc Name)
this_short = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss then Maybe (MDoc Name)
short else Maybe (MDoc Name)
node_short


mkSubTree :: [String] -> Module -> Maybe String -> Maybe String -> Maybe (MDoc Name) -> [ModuleTree]
mkSubTree :: [String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
mkSubTree []     Module
_ Maybe String
_   Maybe String
_      Maybe (MDoc Name)
_     = []
mkSubTree [String
s]    Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short = [String
-> Maybe Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> ModuleTree
Node String
s (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m) Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short []]
mkSubTree (String
s:String
s':[String]
ss) Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short = [String
-> Maybe Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
-> ModuleTree
Node String
s Maybe Module
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe (MDoc Name)
forall a. Maybe a
Nothing ([String]
-> Module
-> Maybe String
-> Maybe String
-> Maybe (MDoc Name)
-> [ModuleTree]
mkSubTree (String
s'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) Module
m Maybe String
pkg Maybe String
srcPkg Maybe (MDoc Name)
short)]


splitModule :: Module -> [String]
splitModule :: Module -> [String]
splitModule Module
mdl = String -> [String]
split (ModuleName -> String
moduleNameString (Module -> ModuleName
moduleName Module
mdl))
  where split :: String -> [String]
split String
mod0 = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
mod0 of
          (String
s1, Char
'.':String
s2) -> String
s1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split String
s2
          (String
s1, String
_)      -> [String
s1]