aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2010-07-21 14:17:32 +0000
committerDavid Waern <david.waern@gmail.com>2010-07-21 14:17:32 +0000
commit25013f63b6df88db06c8ee126686dbfe4655cd5c (patch)
treea7e03a302d870294ec82b64a37e5de5da3497abb
parent6c589874c9fd4772880f758373852db83601dac6 (diff)
More style police
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs10
-rw-r--r--src/Haddock/Backends/Xhtml/Types.hs1
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs21
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",