diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 21 | ||||
| -rw-r--r-- | src/Haddock/Options.hs | 4 |
2 files changed, 17 insertions, 8 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index 52a80096..bf0a9dd0 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -157,14 +157,15 @@ srcButton (Just src_base_url, _, _) Nothing = srcButton (_, Just src_module_url, _) (Just iface) = let url = spliceURL (Just $ ifaceOrigFilename iface) - (Just $ ifaceMod iface) Nothing src_module_url + (Just $ ifaceMod iface) Nothing Nothing src_module_url in topButBox (anchor ! [href url] << toHtml "Source code") srcButton _ _ = Html.emptyTable -spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> String -> String -spliceURL maybe_file maybe_mod maybe_name url = run url +spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> + Maybe SrcSpan -> String -> String +spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url where file = fromMaybe "" maybe_file mod = case maybe_mod of @@ -177,11 +178,17 @@ spliceURL maybe_file maybe_mod maybe_name url = run url Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v") | otherwise -> (escapeStr (getOccString n), "t") + line = case maybe_loc of + Nothing -> "" + Just span -> show $ srcSpanStartLine span + run "" = "" run ('%':'M':rest) = mod ++ run rest run ('%':'F':rest) = file ++ run rest run ('%':'N':rest) = name ++ run rest run ('%':'K':rest) = kind ++ run rest + run ('%':'L':rest) = line ++ run rest + run ('%':'%':rest) = "%" ++ run rest run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest @@ -194,6 +201,8 @@ spliceURL maybe_file maybe_mod maybe_name url = run url run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) = map (\x -> if x == '/' then c else x) file ++ run rest + run ('%':'{':'L':'I':'N':'E':'}':rest) = line ++ run rest + run (c:rest) = c : run rest wikiButton :: WikiURLs -> Maybe Module -> HtmlTable @@ -201,7 +210,7 @@ wikiButton (Just wiki_base_url, _, _) Nothing = topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments") wikiButton (_, Just wiki_module_url, _) (Just mod) = - let url = spliceURL Nothing (Just mod) Nothing wiki_module_url + let url = spliceURL Nothing (Just mod) Nothing Nothing wiki_module_url in topButBox (anchor ! [href url] << toHtml "User Comments") wikiButton _ _ = @@ -1433,14 +1442,14 @@ topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface) Nothing -> Html.emptyTable Just url -> tda [theclass "declbut"] << let url' = spliceURL (Just fname) (Just mod) - (Just name) url + (Just name) (Just loc) url in anchor ! [href url'] << toHtml "Source" wikiLink = case maybe_wiki_url of Nothing -> Html.emptyTable Just url -> tda [theclass "declbut"] << let url' = spliceURL (Just fname) (Just mod) - (Just name) url + (Just name) (Just loc) url in anchor ! [href url'] << toHtml "Comments" mod = ifaceMod iface diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs index 9770f37d..5b710c1f 100644 --- a/src/Haddock/Options.hs +++ b/src/Haddock/Options.hs @@ -115,13 +115,13 @@ options backwardsCompat = (ReqArg Flag_SourceModuleURL "URL") "URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)", Option [] ["source-entity"] (ReqArg Flag_SourceEntityURL "URL") - "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE} or %{NAME} vars)", + "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", Option [] ["comments-base"] (ReqArg Flag_WikiBaseURL "URL") "URL for a comments link on the contents\nand index pages", Option [] ["comments-module"] (ReqArg Flag_WikiModuleURL "URL") "URL for a comments link for each module\n(using the %{MODULE} var)", Option [] ["comments-entity"] (ReqArg Flag_WikiEntityURL "URL") - "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE} or %{NAME} vars)", + "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", Option ['c'] ["css"] (ReqArg Flag_CSS "FILE") "the CSS file to use for HTML output", Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE") |