diff options
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 7 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Types.hs | 3 | ||||
| -rw-r--r-- | html-test/ref/TypeFamilies.html | 30 | ||||
| -rw-r--r-- | html-test/ref/TypeFamilies2.html | 18 |
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 a35e2053..ced7cae5 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 36ed7baf..5ef5a7b9 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 190f376e..1fe20c4b 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -352,8 +352,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" @@ -586,8 +588,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" @@ -944,8 +948,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" @@ -1234,8 +1240,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" @@ -1274,8 +1282,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" |