Tue Nov 28 11:33:29 UTC 2017

Repository : ssh://git@git.haskell.org/haddock

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.16,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11258,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/241346e4e275bdde2d28f90df3225057f4a09cfc

>---------------------------------------------------------------

commit 241346e4e275bdde2d28f90df3225057f4a09cfc
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Sat Jul 25 19:48:08 2015 +0200

    Make hyperlinked source renderer generate line anchors.


>---------------------------------------------------------------

241346e4e275bdde2d28f90df3225057f4a09cfc
 .../src/Haddock/Backends/Hyperlinker/Renderer.hs   | 26 +++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 5037421..15793f0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE RecordWildCards #-}
+
+
 module Haddock.Backends.Hyperlinker.Renderer (render) where
 
 
@@ -78,10 +81,11 @@ header mcss mjs =
 
 
 tokenGroup :: SrcMap -> TokenGroup -> Html
-tokenGroup _ (GrpNormal tok) =
-    tokenSpan tok ! attrs
+tokenGroup _ (GrpNormal tok@(Token { .. }))
+    | tkType == TkSpace = renderSpace (posRow . spStart $ tkSpan) tkValue
+    | otherwise = tokenSpan tok ! attrs
   where
-    attrs = [ multiclass . tokenStyle . tkType $ tok ]
+    attrs = [ multiclass . tokenStyle $ tkType ]
 tokenGroup srcs (GrpRich det tokens) =
     externalAnchor det . internalAnchor det . hyperlink srcs det $ content
   where
@@ -167,3 +171,19 @@ externalModHyperlink (_, srcs) name content = case Map.lookup name srcs of
     Just (SrcExternal path) -> Html.anchor content !
         [ Html.href $ path </> hypSrcModuleUrl' name ]
     Nothing -> content
+
+
+renderSpace :: Int -> String -> Html
+renderSpace _ [] = Html.noHtml
+renderSpace line ('\n':rest) = mconcat
+    [ Html.thespan . Html.toHtml $ "\n"
+    , lineAnchor (line + 1)
+    , renderSpace (line + 1) rest
+    ]
+renderSpace line space =
+    let (hspace, rest) = span (/= '\n') space
+    in (Html.thespan . Html.toHtml) hspace <> renderSpace line rest
+
+
+lineAnchor :: Int -> Html
+lineAnchor line = Html.anchor Html.noHtml ! [ Html.name $ hypSrcLineUrl line ]

