From 7d06f667278dde53285b1abc72701f11f0cccd6f Mon Sep 17 00:00:00 2001
From: Isaac Dupree <id@isaac.cedarswampstudios.org>
Date: Sun, 23 Aug 2009 07:26:05 +0000
Subject: cross-package fnArgDocs. WARNING: changes .haddock binary format
 While breaking the format, I took the opportunity to unrename the DocMap
 that's saved to disk, because there's really no reason that we want to know
 what *another* package's favorite place to link a Name to was.  (Is that
 true? Or might we want to know, someday?)

Also, I added instance Binary Map in InterfaceFile.
It makes the code a little simpler without changing anything of
substance.  Also it lets us add another Map hidden inside another
Map (fnArgsDocs in instDocMap) without having really-convoluted
serialization code.  Instances are neat!
I don't understand why this change to InterfaceFile seemed to
subtly break binary compatibility all by itself, but no matter,
I'll just roll it into the greater format-changing patch. Done!
---
 src/Haddock/Interface/Create.hs | 13 ++++++-------
 src/Haddock/InterfaceFile.hs    | 23 +++++++++++++++--------
 src/Haddock/Types.hs            |  9 +++++++--
 3 files changed, 28 insertions(+), 17 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3