aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs143
1 files changed, 107 insertions, 36 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 5d7e3df7..08c3ba7a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -270,48 +270,13 @@ run flags files = do
-- dump an interface if requested
case dump_iface of
Nothing -> return ()
- Just fn -> do
- bh <- openBinMem 100000
- put_ bh prepared_ifaces
- writeBinMem bh fn
- where
- prepared_ifaces =
- [ (mdl, iface_package iface,
- OptHide `elem` iface_options iface,
- fmToList (iface_env iface),
- fmToList (iface_reexported iface),
- fmToList (iface_sub iface))
- | (mdl, iface) <- these_mod_ifaces ]
+ Just fn -> dumpInterfaces these_mod_ifaces fn
parseIfaceOption :: String -> (FilePath,FilePath)
parseIfaceOption s =
case break (==',') s of
(fpath,',':file) -> (fpath,file)
(file, _) -> ("", file)
-
-readIface :: FilePath -> IO [(Module,Interface)]
-readIface filename = do
- bh <- readBinMem filename
- stuff <- get bh
- return (map to_interface stuff)
- where
- to_interface (mdl, package, hide, env, reexported, sub) =
- (mdl, Interface {
- iface_filename = "",
- iface_package = package,
- iface_env = listToFM env,
- iface_import_env = emptyFM,
- iface_sub = listToFM sub,
- iface_reexported = listToFM reexported,
- iface_exports = [],
- iface_orig_exports = [],
- iface_insts = [],
- iface_decls = emptyFM,
- iface_info = Nothing,
- iface_doc = Nothing,
- iface_options = if hide then [OptHide] else []
- }
- )
updateHTMLXRefs :: [FilePath] -> [[(Module,Interface)]] -> IO ()
@@ -1127,6 +1092,112 @@ collectInstances mod_ifaces
| HsInstDecl _ ctxt (cls,args) _ <- all_instances,
nm <- nub (concat (map freeTyCons args))
]
+
+-- -----------------------------------------------------------------------------
+-- The interface file format.
+-- This has to read interfaces up to Haddock 0.6 (without the short
+-- document annotations), and interfaces afterwards, so we use the
+-- FormatVersion hack to work out which one the interface file contains.
+
+thisFormatVersion :: FormatVersion
+thisFormatVersion = mkFormatVersion 1
+
+-- | How we store interfaces. Not everything is stored.
+type StoredInterface =
+ (Module,Maybe Doc,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)],
+ [(HsName,[HsName])])
+
+-- | How we used to store interfaces.
+type NullVersionStoredInterface =
+ (Module,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)],
+ [(HsName,[HsName])])
+
+dumpInterfaces :: [(Module,Interface)] -> FilePath -> IO ()
+dumpInterfaces interfaces fileName =
+ do
+ let
+ preparedInterfaces :: [StoredInterface]
+ preparedInterfaces = map from_interface interfaces
+
+ bh <- openBinMem 100000
+ put_ bh thisFormatVersion
+ put_ bh preparedInterfaces
+ writeBinMem bh fileName
+
+
+readIface :: FilePath -> IO [(Module,Interface)]
+readIface fileName = do
+ bh <- readBinMem fileName
+ formatVersion <- get bh
+ if formatVersion == thisFormatVersion
+ then
+ do
+ (stuff :: [StoredInterface]) <- get bh
+ return (map to_interface stuff)
+ else
+ if formatVersion == nullFormatVersion
+ then
+ do
+ (stuff :: [NullVersionStoredInterface]) <- get bh
+ return (map nullVersion_to_interface stuff)
+ else
+ do
+ noDieMsg (
+ "Warning: The interface file " ++ show fileName
+ ++ " could not be read.\n"
+ ++ "Maybe it's from a later version of Haddock?\n")
+ return []
+
+from_interface :: (Module,Interface) -> StoredInterface
+from_interface (mdl,iface) =
+ (mdl, toDescription iface,iface_package iface,
+ OptHide `elem` iface_options iface,
+ fmToList (iface_env iface),
+ fmToList (iface_reexported iface),
+ fmToList (iface_sub iface)
+ )
+
+to_interface :: StoredInterface -> (Module,Interface)
+to_interface (mdl,descriptionOpt,package, hide, env, reexported, sub) =
+ (mdl, Interface {
+ iface_filename = "",
+ iface_package = package,
+ iface_env = listToFM env,
+ iface_import_env = emptyFM,
+ iface_sub = listToFM sub,
+ iface_reexported = listToFM reexported,
+ iface_exports = [],
+ iface_orig_exports = [],
+ iface_insts = [],
+ iface_decls = emptyFM,
+ iface_info = toModuleInfo descriptionOpt,
+ iface_doc = Nothing,
+ iface_options = if hide then [OptHide] else []
+ })
+
+nullVersion_to_interface :: NullVersionStoredInterface -> (Module,Interface)
+nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =
+ (mdl, Interface {
+ iface_filename = "",
+ iface_package = package,
+ iface_env = listToFM env,
+ iface_import_env = emptyFM,
+ iface_sub = listToFM sub,
+ iface_reexported = listToFM reexported,
+ iface_exports = [],
+ iface_orig_exports = [],
+ iface_insts = [],
+ iface_decls = emptyFM,
+ iface_info = emptyModuleInfo,
+ iface_doc = Nothing,
+ iface_options = if hide then [OptHide] else []
+ })
+
+toModuleInfo :: Maybe Doc -> ModuleInfo
+toModuleInfo descriptionOpt =
+ emptyModuleInfo {description = descriptionOpt}
+
+
-- -----------------------------------------------------------------------------
-- A monad which collects error messages