aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs7
-rw-r--r--haddock-api/src/Haddock/Types.hs3
-rw-r--r--html-test/ref/TypeFamilies.html30
-rw-r--r--html-test/ref/TypeFamilies2.html18
4 files changed, 40 insertions, 18 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 78242990..c4df2090 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -419,9 +419,12 @@ mkMaps dflags pkgName gre instances decls = do
instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
names :: SrcSpan -> HsDecl GhcRn -> [Name]
- names l (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+ names _ (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
where loc = case d of
- TyFamInstD _ _ -> l -- The CoAx's loc is the whole line, but only for TFs
+ -- The CoAx's loc is the whole line, but only for TFs. The
+ -- workaround is to dig into the family instance declaration and
+ -- get the identifier with the right location.
+ TyFamInstD _ (TyFamInstDecl d') -> getLoc (feqn_tycon (hsib_body d'))
_ -> getInstLoc d
names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
names _ decl = getMainDeclBinder decl
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 01083afb..6da45a3b 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -28,6 +28,7 @@ module Haddock.Types (
import Control.Exception
import Control.Arrow hiding ((<+>))
import Control.DeepSeq
+import Control.Monad.IO.Class (MonadIO(..))
import Data.Typeable
import Data.Map (Map)
import Data.Data (Data)
@@ -661,6 +662,8 @@ instance Monad ErrMsgGhc where
m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
fmap (second (msgs1 ++)) (runWriterGhc (k a))
+instance MonadIO ErrMsgGhc where
+ liftIO m = WriterGhc (fmap (\x -> (x, [])) (liftIO m))
-----------------------------------------------------------------------------
-- * Pass sensitive types
diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html
index 3a93a270..9a4945dd 100644
--- a/html-test/ref/TypeFamilies.html
+++ b/html-test/ref/TypeFamilies.html
@@ -346,8 +346,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >External instance</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -580,8 +582,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo X = Y</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -938,8 +942,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo Y = X</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -1238,8 +1244,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo Y = X</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -1278,8 +1286,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo X = Y</p
+ ></td
></tr
><tr
><td colspan="2"
diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html
index a5d0d9a9..1b4eed8c 100644
--- a/html-test/ref/TypeFamilies2.html
+++ b/html-test/ref/TypeFamilies2.html
@@ -142,8 +142,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Should be visible, but with a hidden right hand side</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -202,8 +204,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >Should be visible, but with a hidden right hand side</p
+ ></td
></tr
><tr
><td colspan="2"
@@ -240,8 +244,10 @@
> <a href="#" class="selflink"
>#</a
></td
- ><td class="doc empty"
- ></td
+ ><td class="doc"
+ ><p
+ >External instance</p
+ ></td
></tr
><tr
><td colspan="2"