-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- 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 qualified Control.Applicative as A
import GHC (Name)
import GHC.Unit.Module (Module, moduleName, moduleNameString, moduleUnit, unitString)
import GHC.Unit.State (UnitState, lookupUnit, unitPackageIdString)

import Haddock.Types (MDoc)

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

mkModuleTree :: UnitState -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree :: UnitState -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree UnitState
state Bool
showPkgs [(Module, Maybe (MDoc Name))]
mods =
  ((Module, [[Char]], Maybe [Char], Maybe [Char], Maybe (MDoc Name))
 -> [ModuleTree] -> [ModuleTree])
-> [ModuleTree]
-> [(Module, [[Char]], Maybe [Char], Maybe [Char],
     Maybe (MDoc Name))]
-> [ModuleTree]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Module, [[Char]], Maybe [Char], Maybe [Char], Maybe (MDoc Name))
-> [ModuleTree] -> [ModuleTree]
fn [] [(Module
mdl, Module -> [[Char]]
splitModule Module
mdl, Module -> Maybe [Char]
forall {u}. IsUnitId u => GenModule u -> Maybe [Char]
modPkg Module
mdl, Module -> Maybe [Char]
modSrcPkg Module
mdl, Maybe (MDoc Name)
short) | (Module
mdl, Maybe (MDoc Name)
short) <- [(Module, Maybe (MDoc Name))]
mods]
  where
    modPkg :: GenModule u -> Maybe [Char]
modPkg GenModule u
mod_
      | Bool
showPkgs = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (u -> [Char]
forall u. IsUnitId u => u -> [Char]
unitString (GenModule u -> u
forall unit. GenModule unit -> unit
moduleUnit GenModule u
mod_))
      | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing
    modSrcPkg :: Module -> Maybe [Char]
modSrcPkg Module
mod_
      | Bool
showPkgs =
          (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
 -> [Char])
-> Maybe
     (GenericUnitInfo PackageId PackageName UnitId ModuleName Module)
-> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageIdString
            (UnitState
-> Unit
-> Maybe
     (GenericUnitInfo PackageId PackageName UnitId ModuleName Module)
lookupUnit UnitState
state (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod_))
      | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing
    fn :: (Module, [[Char]], Maybe [Char], Maybe [Char], Maybe (MDoc Name))
-> [ModuleTree] -> [ModuleTree]
fn (Module
m, [[Char]]
mod_, Maybe [Char]
pkg, Maybe [Char]
srcPkg, Maybe (MDoc Name)
short) = [[Char]]
-> Module
-> Maybe [Char]
-> Maybe [Char]
-> Maybe (MDoc Name)
-> [ModuleTree]
-> [ModuleTree]
addToTrees [[Char]]
mod_ Module
m Maybe [Char]
pkg Maybe [Char]
srcPkg Maybe (MDoc Name)
short

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

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

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