aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2011-06-17 19:10:29 +0100
committerIan Lynagh <igloo@earth.li>2011-06-17 19:10:29 +0100
commit8739a6bd59f562bb550c915f1d2b2a327b748572 (patch)
tree6ce78264c2b2e1103209c70f3560b816f884937e
parentab24835eadb99059934d7a14f86564eea6449257 (diff)
Fix build
-rw-r--r--src/Haddock/Backends/Xhtml.hs2
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs2
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs4
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs9
-rw-r--r--src/Haddock/GhcUtils.hs4
-rw-r--r--src/Haddock/Interface/Create.hs2
-rw-r--r--src/Haddock/Lex.x17
-rw-r--r--src/Haddock/Types.hs1
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
-----------------------------------------------------------------------------