Teach haddock about line pragmas and add accurate source code links

Teach haddock about C and Haskell style line pragmas. Extend the lexer/parser's
source location tracking to include the file name as well as line/column. This
way each AST item that is tagged with a SrcLoc gets the original file name too.

Use this original file name to add source links to each exported item, in the
same visual style as the wiki links. Note that the per-export source links are
to the defining module rather than whichever module haddock pretends it is
exported from. This is what we want for source code links. The source code link
URL can also contain the name of the export so one could implement jumping to
the actual location of the function in the file if it were linked to an html
version of the source rather than just plain text. The name can be selected
with the %N wild card.

So for linking to the raw source code one might use:
--source=http://darcs/haskell.org/foo/%F

Or for linking to html syntax highlighted code:
--source=http://darcs/haskell.org/foo/%M.html#%N

1 files changed, 10 insertions, 9 deletions

diff --git a/src/HsParseMonad.lhs b/src/HsParseMonad.lhs
index 748fbad1..f1423f6f 100644
--- a/src/HsParseMonad.lhs
+++ b/src/HsParseMonad.lhs
@@ -27,14 +27,15 @@ type P a
      -> SrcLoc			-- location of last token read
      -> Int			-- current line
      -> Int			-- current column
+     -> FilePath		-- current original filename
      -> ParseState		-- layout info.
      -> ParseResult a
 
 thenP :: P a -> (a -> P b) -> P b
-m `thenP` k = \i l n c s0 -> 
-	case m i l n c s0 of 
+m `thenP` k = \i l n c f s0 -> 
+	case m i l n c f s0 of 
 	    Failed s -> Failed s
-	    Ok s' a -> case k a of k' -> k' i l n c s'
+	    Ok s' a -> case k a of k' -> k' i l n c f s'
 
 thenP_ :: P a -> P b -> P b
 m `thenP_` k = m `thenP` \_ -> k
@@ -47,24 +48,24 @@ mapP f (a:as) =
      returnP (b:bs)
 
 returnP :: a -> P a
-returnP a = \_ _ _ _ s -> Ok s a
+returnP a = \_ _ _ _ _ s -> Ok s a
 
 failP :: String -> P a
-failP err = \_ _ _ _ _ -> Failed err
+failP err = \_ _ _ _ _ _ -> Failed err
 
 getSrcLoc :: P SrcLoc
-getSrcLoc = \_ l _ _ s -> Ok s l
+getSrcLoc = \_ l _ _ _ s -> Ok s l
 
 getContext :: P [LexContext]
-getContext = \_ _ _ _ s -> Ok s s
+getContext = \_ _ _ _ _ s -> Ok s s
 
 pushContext :: LexContext -> P ()
 pushContext ctxt = 
 --trace ("pushing lexical scope: " ++ show ctxt ++"\n") $
-	\_ _ _ _ s -> Ok (ctxt:s) ()
+	\_ _ _ _ _ s -> Ok (ctxt:s) ()
 
 popContext :: P ()
-popContext = \_ _ _ _ stk ->
+popContext = \_ _ _ _ _ stk ->
       case stk of
    	(_:s) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $ 
             Ok s ()