diff options
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 5 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 7 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Themes.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 2 |
6 files changed, 20 insertions, 20 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index e597bab0..b9296be5 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -240,13 +240,12 @@ markupTag = Markup { markupCodeBlock = box TagPre, markupURL = box (TagInline "a") . str, markupAName = const $ str "", - markupExample = box TagPre . str . unlines . (map exampleToString) + markupExample = box TagPre . str . unlines . map exampleToString } showTags :: [Tag] -> [String] -showTags = concat . intersperse [""] . map showBlock - where +showTags = intercalate [""] . map showBlock showBlock :: Tag -> [String] diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index 1e43891d..93536834 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -64,11 +64,11 @@ parHtmlMarkup ppId isTyCon = Markup { | isTyCon x = x | otherwise = y - examplesToHtml l = (pre $ concatHtml $ map exampleToHtml l) ! [theclass "screen"] + examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"] exampleToHtml (Example expression result) = htmlExample where - htmlExample = htmlPrompt +++ htmlExpression +++ (toHtml $ unlines result) + htmlExample = htmlPrompt +++ htmlExpression +++ toHtml (unlines result) htmlPrompt = (thecode . toHtml $ ">>> ") ! [theclass "prompt"] htmlExpression = (strong . thecode . toHtml $ expression ++ "\n") ! [theclass "userinput"] @@ -98,7 +98,7 @@ docElement el content_ = docSection :: Qualification -> Doc DocName -> Html -docSection qual = (docElement thediv <<) . (docToHtml qual) +docSection qual = (docElement thediv <<) . docToHtml qual maybeDocSection :: Qualification -> Maybe (Doc DocName) -> Html diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index a6518938..e5d8c24e 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -141,7 +141,7 @@ subBlock hs = Just $ toHtml hs subArguments :: Qualification -> [SubDecl] -> Html -subArguments qual = divSubDecls "arguments" "Arguments" . (subTable qual) +subArguments qual = divSubDecls "arguments" "Arguments" . subTable qual subAssociatedTypes :: [Html] -> Html @@ -149,19 +149,19 @@ subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBloc subConstructors :: Qualification -> [SubDecl] -> Html -subConstructors qual = divSubDecls "constructors" "Constructors" . (subTable qual) +subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual subFields :: Qualification -> [SubDecl] -> Html -subFields qual = divSubDecls "fields" "Fields" . (subDlist qual) +subFields qual = divSubDecls "fields" "Fields" . subDlist qual subInstances :: Qualification -> String -> [SubDecl] -> Html subInstances qual nm = maybe noHtml wrap . instTable where wrap = (subSection <<) . (subCaption +++) - instTable = fmap (thediv ! collapseSection id_ True [] <<) . (subTable qual) - subSection = thediv ! [theclass $ "subs instances"] + instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable qual + subSection = thediv ! [theclass "subs instances"] subCaption = paragraph ! collapseControl id_ True "caption" << "Instances" id_ = makeAnchorId $ "i:" ++ nm diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 4d9f0739..406b8995 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -50,10 +50,9 @@ qualifyName qual docName@(Documented name mdl) = case qual of FullQual -> ppFullQualName mdl name -- this is just in case, it should never happen LocalQual Nothing -> qualifyName FullQual docName - LocalQual (Just localmdl) -> - if (moduleString mdl == moduleString localmdl) - then ppName name - else ppFullQualName mdl name + LocalQual (Just localmdl) + | moduleString mdl == moduleString localmdl -> ppName name + | otherwise -> ppFullQualName mdl name -- again, this never happens RelativeQual Nothing -> qualifyName FullQual docName RelativeQual (Just localmdl) -> diff --git a/src/Haddock/Backends/Xhtml/Themes.hs b/src/Haddock/Backends/Xhtml/Themes.hs index cbcf10a4..79b093ec 100644 --- a/src/Haddock/Backends/Xhtml/Themes.hs +++ b/src/Haddock/Backends/Xhtml/Themes.hs @@ -18,6 +18,7 @@ module Haddock.Backends.Xhtml.Themes ( import Haddock.Options +import Control.Applicative import Control.Monad (liftM) import Data.Char (toLower) import Data.Either (lefts, rights) @@ -97,13 +98,13 @@ directoryTheme path = do -- | Check if we have a built in theme doesBuiltInExist :: IO PossibleThemes -> String -> IO Bool -doesBuiltInExist pts s = pts >>= return . either (const False) test +doesBuiltInExist pts s = fmap (either (const False) test) pts where test = isJust . findTheme s -- | Find a built in theme builtInTheme :: IO PossibleThemes -> String -> IO PossibleTheme -builtInTheme pts s = pts >>= return . either Left fetch +builtInTheme pts s = either Left fetch <$> pts where fetch = maybe (Left ("Unknown theme: " ++ s)) Right . findTheme s @@ -157,9 +158,10 @@ retRight = return . Right -- * File Utilities -------------------------------------------------------------------------------- + getDirectoryItems :: FilePath -> IO [FilePath] getDirectoryItems path = - getDirectoryContents path >>= return . map (combine path) . filter notDot + map (combine path) . filter notDot <$> getDirectoryContents path where notDot s = s /= "." && s /= ".." @@ -178,7 +180,7 @@ cssFiles ts = nub $ concatMap themeFiles ts styleSheet :: Themes -> Html styleSheet ts = toHtml $ zipWith mkLink rels ts where - rels = ("stylesheet" : repeat "alternate stylesheet") + rels = "stylesheet" : repeat "alternate stylesheet" mkLink aRel t = thelink ! [ href (themeHref t), rel aRel, thetype "text/css", diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs index f0b6941c..3fd461fd 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/src/Haddock/Backends/Xhtml/Utils.hs @@ -67,7 +67,7 @@ spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url run ('%':'N':rest) = name ++ run rest run ('%':'K':rest) = kind ++ run rest run ('%':'L':rest) = line ++ run rest - run ('%':'%':rest) = "%" ++ run rest + run ('%':'%':rest) = "%" ++ run rest run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl ++ run rest run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest |