diff options
Diffstat (limited to 'src/Haddock/Backends')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Types.hs | 1 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 21 | 
3 files changed, 29 insertions, 3 deletions
| diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 0c7df9a8..068fc0f7 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -17,6 +17,7 @@ module Haddock.Backends.Xhtml.Names (    linkId  ) where +  import Haddock.Backends.Xhtml.Utils  import Haddock.GhcUtils  import Haddock.Types @@ -28,21 +29,26 @@ import GHC  import Name  import RdrName +  ppOccName :: OccName -> Html  ppOccName = toHtml . occNameString +  ppRdrName :: RdrName -> Html  ppRdrName = ppOccName . rdrNameOcc +  ppLDocName :: Located DocName -> Html  ppLDocName (L _ d) = ppDocName d +  ppDocName :: DocName -> Html  ppDocName (Documented name mdl) =    linkIdOcc mdl (Just occName) << ppOccName occName      where occName = nameOccName name  ppDocName (Undocumented name) = toHtml (getOccString name) +  ppName :: Name -> Html  ppName name = toHtml (getOccString name) @@ -72,13 +78,15 @@ linkIdOcc mdl mbName = anchor ! [href url]        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) -    -- NB: The ref paramaeter already includes the '#'. +    -- NB: The ref parameter already includes the '#'.      -- This function is only called from markupModule expanding a      -- DocModule, which doesn't seem to be ever be used. diff --git a/src/Haddock/Backends/Xhtml/Types.hs b/src/Haddock/Backends/Xhtml/Types.hs index aff47131..4e23f469 100644 --- a/src/Haddock/Backends/Xhtml/Types.hs +++ b/src/Haddock/Backends/Xhtml/Types.hs @@ -20,5 +20,6 @@ module Haddock.Backends.Xhtml.Types (  type SourceURLs = (Maybe String, Maybe String, Maybe String)  type WikiURLs = (Maybe String, Maybe String, Maybe String) +  -- The URL for source and wiki links, and the current module  type LinksInfo = (SourceURLs, WikiURLs) diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs index 78754138..443cb459 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/src/Haddock/Backends/Xhtml/Utils.hs @@ -29,6 +29,7 @@ module Haddock.Backends.Xhtml.Utils (    cssFiles, styleSheet, stylePickers, styleMenu  ) where +  import Haddock.GhcUtils  import Haddock.Utils @@ -89,25 +90,31 @@ renderToString :: Html -> String  renderToString = showHtml     -- for production  --renderToString = prettyHtml   -- for debugging +  hsep :: [Html] -> Html  hsep [] = noHtml  hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls +  infixr 8 <+>  (<+>) :: Html -> Html -> Html  a <+> b = a +++ toHtml " " +++ b +  keyword :: String -> Html  keyword s = thespan ! [theclass "keyword"] << toHtml s +  equals, comma :: Html  equals = char '='  comma  = char ',' +  char :: Char -> Html  char c = toHtml [c] --- | ensure content contains at least something (a non-breaking space) + +-- | Ensure content contains at least something (a non-breaking space)  nonEmpty :: (HTML a) => a -> Html  nonEmpty a = if isNoHtml h then spaceHtml else h      where h = toHtml a @@ -123,6 +130,7 @@ brackets h      = char '[' +++ h +++ char ']'  pabrackets h    = toHtml "[:" +++ h +++ toHtml ":]"  braces h        = char '{' +++ h +++ char '}' +  punctuate :: Html -> [Html] -> [Html]  punctuate _ []     = []  punctuate h (d0:ds) = go d0 ds @@ -130,12 +138,15 @@ punctuate h (d0:ds) = go d0 ds                       go d [] = [d]                       go d (e:es) = (d +++ h) : go e es +  parenList :: [Html] -> Html  parenList = parens . hsep . punctuate comma +  ubxParenList :: [Html] -> Html  ubxParenList = ubxparens . hsep . punctuate comma +  ubxparens :: Html -> Html  ubxparens h = toHtml "(#" +++ h +++ toHtml "#)" @@ -155,14 +166,15 @@ dot :: Html  dot = toHtml "." -  -- | Generate a named anchor  namedAnchor :: String -> Html -> Html  namedAnchor n = anchor ! [XHtml.name n] +  linkedAnchor :: String -> Html -> Html  linkedAnchor n = anchor ! [href ('#':n)] +  --  -- A section of HTML which is collapsible via a +/- button.  -- @@ -175,6 +187,7 @@ collapsebutton :: String -> Html  collapsebutton id_ =    image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id_ ++ "')"), alt "show/hide" ] +  -- A quote is a valid part of a Haskell identifier, but it would interfere with  -- the ECMA script string delimiter used in collapsebutton above.  collapseId :: Name -> String @@ -189,9 +202,11 @@ cssThemes = [      ("Snappy", "shaddock.css")      ] +  cssFiles :: [String]  cssFiles = map snd cssThemes +  styleSheet :: Html  styleSheet = toHtml $ zipWith mkLink cssThemes rels    where @@ -199,6 +214,7 @@ styleSheet = toHtml $ zipWith mkLink cssThemes rels      mkLink (aTitle, aFile) aRel =         (thelink ! [href aFile, rel aRel, thetype "text/css", XHtml.title aTitle]) noHtml +  stylePickers :: [Html]  stylePickers = map mkPicker cssThemes    where @@ -206,6 +222,7 @@ stylePickers = map mkPicker cssThemes        let js = "setActiveStyleSheet('" ++ aFile ++ "'); return false;" in        anchor ! [href "#", onclick js] << aTitle +  styleMenu :: Html  styleMenu = thediv ! [identifier "style-menu-holder"] << [      anchor ! [ href "#", onclick js ] << "Style\9662", | 
