diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 4 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 9 |
3 files changed, 11 insertions, 4 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index bd93ac25..add926ab 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -58,7 +58,7 @@ ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> - [DocName] -> HsType DocName -> Bool Qualification -> Html + [DocName] -> HsType DocName -> Bool -> Qualification -> Html ppFunSig summary links loc doc docnames typ unicode qual = ppTypeOrFunSig summary links loc docnames typ doc ( ppTypeSig summary occnames typ unicode qual diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 91eac9c6..bdd5ac78 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -204,5 +204,7 @@ topDeclElem ((_,_,sourceMap), (_,_,maybe_wiki_url)) loc names html = Documented n mdl = head names -- FIXME: is it ok to simply take the first name? - fname = unpackFS (srcSpanFile loc) + fname = case loc of + RealSrcSpan l -> unpackFS (srcSpanFile l) + UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan" diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs index c250f5eb..7ba6d5f4 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/src/Haddock/Backends/Xhtml/Utils.hs @@ -37,7 +37,7 @@ import Data.Maybe import Text.XHtml hiding ( name, title, p, quote ) import qualified Text.XHtml as XHtml -import GHC ( SrcSpan, srcSpanStartLine, Name ) +import GHC ( SrcSpan(..), srcSpanStartLine, Name ) import Module ( Module ) import Name ( getOccString, nameOccName, isValOcc ) @@ -59,7 +59,12 @@ spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url line = case maybe_loc of Nothing -> "" - Just span_ -> show $ srcSpanStartLine span_ + Just span_ -> + case span_ of + RealSrcSpan span__ -> + show $ srcSpanStartLine span__ + UnhelpfulSpan _ -> + error "spliceURL UnhelpfulSpan" run "" = "" run ('%':'M':rest) = mdl ++ run rest |