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

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

-- |
-- 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, [String], Maybe String, Maybe String, Maybe (MDoc Name))
 -> [ModuleTree] -> [ModuleTree])
-> [ModuleTree]
-> [(Module, [String], Maybe String, Maybe String,
     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, [String], Maybe String, Maybe String, Maybe (MDoc Name))
-> [ModuleTree] -> [ModuleTree]
fn [] [(Module
mdl, Module -> [String]
splitModule Module
mdl, Module -> Maybe String
forall {u}. IsUnitId u => GenModule u -> 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 :: GenModule u -> Maybe String
modPkg GenModule u
mod_
      | Bool
showPkgs = String -> Maybe String
forall a. a -> Maybe a
Just (u -> String
forall u. IsUnitId u => u -> String
unitString (GenModule u -> u
forall unit. GenModule unit -> unit
moduleUnit GenModule u
mod_))
      | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
    modSrcPkg :: Module -> Maybe String
modSrcPkg Module
mod_
      | Bool
showPkgs =
          (GenUnitInfo UnitId -> String)
-> Maybe (GenUnitInfo UnitId) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            GenUnitInfo UnitId -> String
forall u. GenUnitInfo u -> String
unitPackageIdString
            (UnitState -> Unit -> Maybe (GenUnitInfo UnitId)
lookupUnit UnitState
state (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit 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
s1 String -> [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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
A.<|> (if [String] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) 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
s1 String -> [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 a. [a] -> Bool
forall (t :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) 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
forall unit. GenModule unit -> 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]