aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Haddock/Interface/Create.hs13
-rw-r--r--src/Haddock/InterfaceFile.hs23
-rw-r--r--src/Haddock/Types.hs9
3 files changed, 28 insertions, 17 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index d919ab4b..65028a9f 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -509,15 +509,14 @@ mkExportItems modMap this_mod gre exported_names decls declMap
let hsdecl = tyThingToHsSynSig tyThing
return [ mkExportDecl t
( hsdecl
- , (fmap (fmapHsDoc getName) $
- Map.lookup t (instDocMap iface), Map.empty{-todo-})
+ , fromMaybe noDocForDecl $
+ Map.lookup t (instDocMap iface)
, map (\subt ->
- ( subt
- , (fmap (fmapHsDoc getName) $
- Map.lookup subt (instDocMap iface), Map.empty{-todo-})
+ ( subt ,
+ fromMaybe noDocForDecl $
+ Map.lookup subt (instDocMap iface)
)
- )
- subs
+ ) subs
)]
mkExportDecl :: Name -> DeclInfo -> ExportItem Name
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 81361997..083735c1 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -27,6 +27,7 @@ import Data.Word
import Data.Array
import Data.IORef
import qualified Data.Map as Map
+import Data.Map (Map)
import GHC hiding (NoLink)
import Binary
@@ -56,9 +57,9 @@ binaryInterfaceMagic = 0xD0Cface
-- we version our interface files accordingly.
binaryInterfaceVersion :: Word16
#if __GLASGOW_HASKELL__ == 610
-binaryInterfaceVersion = 12
+binaryInterfaceVersion = 14
#elif __GLASGOW_HASKELL__ == 611
-binaryInterfaceVersion = 13
+binaryInterfaceVersion = 15
#endif
@@ -332,27 +333,33 @@ serialiseName bh name _ = do
-- GhcBinary instances
-------------------------------------------------------------------------------
+-- Hmm, why didn't we dare to make this instance already? It makes things
+-- much easier.
+instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
+ put_ bh m = put_ bh (Map.toAscList m)
+ get bh = fmap (Map.fromAscList) (get bh)
+
instance Binary InterfaceFile where
put_ bh (InterfaceFile env ifaces) = do
- put_ bh (Map.toList env)
+ put_ bh env
put_ bh ifaces
get bh = do
env <- get bh
ifaces <- get bh
- return (InterfaceFile (Map.fromList env) ifaces)
+ return (InterfaceFile env ifaces)
instance Binary InstalledInterface where
put_ bh (InstalledInterface modu info docMap exps visExps opts subMap) = do
put_ bh modu
put_ bh info
- put_ bh (Map.toList docMap)
+ put_ bh docMap
put_ bh exps
put_ bh visExps
put_ bh opts
- put_ bh (Map.toList subMap)
+ put_ bh subMap
get bh = do
modu <- get bh
@@ -363,8 +370,8 @@ instance Binary InstalledInterface where
opts <- get bh
subMap <- get bh
- return (InstalledInterface modu info (Map.fromList docMap)
- exps visExps opts (Map.fromList subMap))
+ return (InstalledInterface modu info docMap
+ exps visExps opts subMap)
instance Binary DocOption where
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 6d53f88d..ac3f2b5f 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -227,7 +227,7 @@ data InstalledInterface = InstalledInterface {
instInfo :: HaddockModInfo Name,
-- | Everything declared in the module (including subordinates) that has docs
- instDocMap :: Map Name (HsDoc DocName),
+ instDocMap :: Map Name (DocForDecl Name),
-- | All names exported by this module
instExports :: [Name],
@@ -256,13 +256,18 @@ toInstalledIface :: Interface -> InstalledInterface
toInstalledIface interface = InstalledInterface {
instMod = ifaceMod interface,
instInfo = ifaceInfo interface,
- instDocMap = Map.mapMaybe fst $ ifaceRnDocMap interface,--todo.
+ instDocMap = fmap unrenameDocForDecl $ ifaceRnDocMap interface,
instExports = ifaceExports interface,
instVisibleExports = ifaceVisibleExports interface,
instOptions = ifaceOptions interface,
instSubMap = ifaceSubMap interface
}
+unrenameHsDoc :: HsDoc DocName -> HsDoc Name
+unrenameHsDoc = fmapHsDoc getName
+unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
+unrenameDocForDecl (mbDoc, fnArgsDoc) =
+ (fmap unrenameHsDoc mbDoc, fmap unrenameHsDoc fnArgsDoc)
#if __GLASGOW_HASKELL__ >= 611
data HsDoc id