Fix build

8 files changed, 27 insertions, 14 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index d3d3c79c..600a5362 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -571,7 +571,7 @@ processForMiniSynopsis mdl unicode _ (ExportDecl (L _loc decl0) _doc _ _insts) =
     _ -> []
 processForMiniSynopsis _ _ qual (ExportGroup lvl _id txt) =
   [groupTag lvl << docToHtml qual txt]
-processForMiniSynopsis _ _ _ = []
+processForMiniSynopsis _ _ _ _ = []
 
 
 ppNameMini :: Module -> OccName -> Html
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
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 597ed123..f79acd94 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -179,11 +179,11 @@ reL :: a -> Located a
 reL = L undefined
 
 
-instance Foldable Located where
+instance Foldable (GenLocated l) where
   foldMap f (L _ x) = f x
 
 
-instance Traversable Located where
+instance Traversable (GenLocated l) where
   mapM f (L l x) = (return . L l) =<< f x
 
 
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 78c73c09..f9d72bd0 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -682,7 +682,7 @@ moduleExports :: Module           -- ^ Module A
               -> IfaceMap         -- ^ Already created interfaces
               -> InstIfaceMap     -- ^ Interfaces in other packages
               -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items
-moduleExports thisMod expMod dflags gre exports decls ifaceMap instIfaceMap
+moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap
   | m == thisMod = liftErrMsg $ fullContentsOfThisModule dflags gre decls
   | otherwise =
     case Map.lookup m ifaceMap of
diff --git a/src/Haddock/Lex.x b/src/Haddock/Lex.x
index 2f0b4cd3..17267656 100644
--- a/src/Haddock/Lex.x
+++ b/src/Haddock/Lex.x
@@ -28,6 +28,7 @@ import StringBuffer
 import RdrName
 import SrcLoc
 import DynFlags
+import FastString
 
 import Data.Char
 import Numeric
@@ -178,19 +179,25 @@ begin sc = \_ _ _ cont _ -> cont sc
 
 ident :: Action
 ident pos str sc cont dflags = 
-  case strToHsQNames dflags id of
+  case strToHsQNames dflags loc id of
 	Just names -> (TokIdent names, pos) : cont sc
 	Nothing -> (TokString str, pos) : cont sc
  where id = init (tail str)
-
-strToHsQNames :: DynFlags -> String -> Maybe [RdrName]
-strToHsQNames dflags str0 = 
+       -- TODO: Get the real filename here. Maybe we should just be
+       --       using GHC SrcLoc's ourself?
+       filename = mkFastString "<unknown file>"
+       loc = case pos of
+             AlexPn _ line col ->
+                 mkRealSrcLoc filename line col
+
+strToHsQNames :: DynFlags -> RealSrcLoc -> String -> Maybe [RdrName]
+strToHsQNames dflags loc str0 = 
 #if MIN_VERSION_ghc(7,1,0)
   let buffer = stringToStringBuffer str0
 #else
   let buffer = unsafePerformIO (stringToStringBuffer str0)
 #endif
-      pstate = mkPState dflags buffer noSrcLoc
+      pstate = mkPState dflags buffer loc
       result = unP parseIdentifier pstate 
   in case result of 
        POk _ name -> Just [unLoc name] 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index db8a3198..d82e3efd 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -26,7 +26,6 @@ import Data.Typeable
 import Data.Map (Map)
 import qualified Data.Map as Map
 import GHC hiding (NoLink)
-import Name
 
 
 -----------------------------------------------------------------------------