diff options
| author | jpmoresmau <jp@moresmau.fr> | 2015-05-17 15:31:03 +0200 | 
|---|---|---|
| committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-06-12 16:03:16 +0100 | 
| commit | 3d11080b9f56a901593b6237d674d617a429e64a (patch) | |
| tree | 4315c3a4fec5ab5a248ac6dc9802be7ee96186d4 /haddock-api/src/Haddock/Backends | |
| parent | 5aaa14fa020da56be7fdf943f6da3310d11a3593 (diff) | |
Attach to instance location the name that has the same location file
Fixes #383
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 24 | 
3 files changed, 17 insertions, 17 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 125e1b3a..2febd5ae 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -544,14 +544,14 @@ ppDocInstances unicode (i : rest)      (is, rest') = spanWith isUndocdInstance rest  isUndocdInstance :: DocInstance a -> Maybe (InstHead a) -isUndocdInstance (L _ i,Nothing) = Just i +isUndocdInstance (i,Nothing,_) = Just i  isUndocdInstance _ = Nothing  -- | Print a possibly commented instance. The instance header is printed inside  -- an 'argBox'. The comment is printed to the right of the box in normal comment  -- style.  ppDocInstance :: Bool -> DocInstance DocName -> LaTeX -ppDocInstance unicode (L _ instHead, doc) = +ppDocInstance unicode (instHead, doc, _) =    declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 952d29c9..df85a492 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -497,12 +497,12 @@ ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppS  ppInstances :: LinksInfo -> [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html  ppInstances links instances baseName unicode qual -  = subInstances qual instName links True baseName (map instDecl instances) +  = subInstances qual instName links True (map instDecl instances)    -- force Splice = True to use line URLs    where      instName = getOccString $ getName baseName -    instDecl :: DocInstance DocName -> (SubDecl,SrcSpan) -    instDecl (L l inst, maybeDoc) = ((instHead inst, maybeDoc, []),l) +    instDecl :: DocInstance DocName -> (SubDecl,Located DocName) +    instDecl (inst, maybeDoc,l) = ((instHead inst, maybeDoc, []),l)      instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual          <+> ppAppNameTypes n ks ts unicode qual      instHead (n, ks, ts, TypeInst rhs) = keyword "type" diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 923958a7..e686d648 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -44,7 +44,6 @@ import Haddock.Backends.Xhtml.Types  import Haddock.Backends.Xhtml.Utils  import Haddock.Types  import Haddock.Utils (makeAnchorId) -  import qualified Data.Map as Map  import Text.XHtml hiding ( name, title, p, quote ) @@ -148,20 +147,21 @@ subTable qual decls = Just $ table << aboves (concatMap subRow decls)         docElement td << fmap (docToHtml Nothing qual) mdoc)        : map (cell . (td <<)) subs +  -- | Sub table with source information (optional). -subTableSrc :: Qualification -> LinksInfo -> Bool -> DocName -> [(SubDecl,SrcSpan)] -> Maybe Html -subTableSrc _ _  _ _ [] = Nothing -subTableSrc qual lnks splice dn decls = Just $ table << aboves (concatMap subRow decls) +subTableSrc :: Qualification -> LinksInfo -> Bool -> [(SubDecl,Located DocName)] -> Maybe Html +subTableSrc _ _  _ [] = Nothing +subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)    where -    subRow ((decl, mdoc, subs),loc) = +    subRow ((decl, mdoc, subs),L loc dn) =        (td ! [theclass "src"] << decl -      <+> linkHtml loc +      <+> linkHtml loc dn        <->        docElement td << fmap (docToHtml Nothing qual) mdoc        )        : map (cell . (td <<)) subs -    linkHtml loc@(RealSrcSpan _) = links lnks loc splice dn -    linkHtml _ = noHtml +    linkHtml loc@(RealSrcSpan _) dn = links lnks loc splice dn +    linkHtml _ _ = noHtml  subBlock :: [Html] -> Maybe Html  subBlock [] = Nothing @@ -191,12 +191,12 @@ subEquations qual = divSubDecls "equations" "Equations" . subTable qual  -- | Generate sub table for instance declarations, with source  subInstances :: Qualification               -> String -- ^ Class name, used for anchor generation -             -> LinksInfo -> Bool -> DocName -             -> [(SubDecl,SrcSpan)] -> Html -subInstances qual nm lnks splice dn = maybe noHtml wrap . instTable +             -> LinksInfo -> Bool +             -> [(SubDecl,Located DocName)] -> Html +subInstances qual nm lnks splice = maybe noHtml wrap . instTable    where      wrap = (subSection <<) . (subCaption +++) -    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice dn +    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice      subSection = thediv ! [theclass "subs instances"]      subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"      id_ = makeAnchorId $ "i:" ++ nm  | 
