module Haddock.Backends.Xhtml.Names (
ppName, ppDocName, ppLDocName, ppRdrName,
ppBinder, ppBinder',
ppModule, ppModuleRef,
linkId
) where
import Haddock.Backends.Xhtml.Utils
import Haddock.GhcUtils
import Haddock.Types
import Haddock.Utils
import Text.XHtml hiding ( name, title, p, quote )
import qualified Data.List as List
import GHC
import Name
import RdrName
ppOccName :: OccName -> Html
ppOccName = toHtml . occNameString
ppRdrName :: RdrName -> Html
ppRdrName = ppOccName . rdrNameOcc
ppLDocName :: Qualification -> Located DocName -> Html
ppLDocName qual (L _ d) = ppDocName qual d
ppDocName :: Qualification -> DocName -> Html
ppDocName qual docName =
case docName of
Documented name mdl ->
linkIdOcc mdl (Just (nameOccName name)) << ppQualifyName qual name mdl
Undocumented name -> ppQualifyName qual name (nameModule name)
ppQualifyName :: Qualification -> Name -> Module -> Html
ppQualifyName qual name mdl =
case qual of
NoQual -> ppName name
FullQual -> ppFullQualName mdl name
LocalQual Nothing -> ppQualifyName FullQual name mdl
LocalQual (Just localmdl)
| moduleString mdl == moduleString localmdl -> ppName name
| otherwise -> ppFullQualName mdl name
RelativeQual Nothing -> ppQualifyName FullQual name mdl
RelativeQual (Just localmdl) ->
case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
Just [] -> ppQualifyName NoQual name mdl
Just ('.':m) -> toHtml $ m ++ '.' : getOccString name
Just _ -> ppQualifyName FullQual name mdl
Nothing -> ppQualifyName FullQual name mdl
ppFullQualName :: Module -> Name -> Html
ppFullQualName mdl name = toHtml $ moduleString mdl ++ '.' : getOccString name
ppName :: Name -> Html
ppName name = toHtml (getOccString name)
ppBinder :: Bool -> OccName -> Html
ppBinder True n = linkedAnchor (nameAnchorId n) << ppBinder' n
ppBinder False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
<< ppBinder' n
ppBinder' :: OccName -> Html
ppBinder' n
| isVarSym n = parens $ ppOccName n
| otherwise = ppOccName n
linkId :: Module -> Maybe Name -> Html -> Html
linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName)
linkIdOcc :: Module -> Maybe OccName -> Html -> Html
linkIdOcc mdl mbName = anchor ! [href url]
where
url = case mbName of
Nothing -> moduleUrl mdl
Just name -> moduleNameUrl mdl name
ppModule :: Module -> Html
ppModule mdl = anchor ! [href (moduleUrl mdl)]
<< toHtml (moduleString mdl)
ppModuleRef :: Module -> String -> Html
ppModuleRef mdl ref = anchor ! [href (moduleUrl mdl ++ ref)]
<< toHtml (moduleString mdl)