diff options
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 13 | ||||
| -rw-r--r-- | src/Haddock/InterfaceFile.hs | 23 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 9 |
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 |