aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Interface.hs345
-rw-r--r--src/Main.hs303
2 files changed, 393 insertions, 255 deletions
diff --git a/src/Interface.hs b/src/Interface.hs
new file mode 100644
index 00000000..0578fe83
--- /dev/null
+++ b/src/Interface.hs
@@ -0,0 +1,345 @@
+module Interface (
+ Interface,
+ dumpInterface,
+ readInterface
+) where
+
+import HaddockUtil ( noDieMsg, moduleString )
+import Binary2 ( BinHandle, Binary(..), FormatVersion, mkFormatVersion,
+ openBinMem, writeBinMem, readBinMem, putByte, getByte,
+ getString, putString )
+
+import Name ( Name, nameOccName, nameModule, mkExternalName )
+import OccName ( OccName, isVarOcc, isDataOcc, isTvOcc, isTcOcc, varName,
+ dataName, tvName, tcClsName, occNameString, mkOccName )
+import Unique ( mkUnique )
+import Module ( Module, mkModule, mkModuleName, modulePackageId )
+import PackageConfig ( packageIdString, stringToPackageId )
+import SrcLoc ( noSrcLoc )
+
+import qualified Data.Map as Map
+import Data.Map (Map)
+
+------------------------------------------------------------------------------
+-- Reading the current interface format
+------------------------------------------------------------------------------
+
+thisFormatVersion :: FormatVersion
+thisFormatVersion = mkFormatVersion 3
+
+dumpInterface :: Map Name Name -> [Module] -> FilePath -> IO ()
+dumpInterface globalDocEnv modules fileName = do
+ bh <- openBinMem 100000
+ put_ bh thisFormatVersion
+ mapM (put_ bh) modules
+ putDocEnv bh globalDocEnv
+ writeBinMem bh fileName
+
+putDocEnv :: BinHandle -> Map Name Name -> IO ()
+putDocEnv bh env = put_ bh list
+ where
+ list = [ (nameModule o, nameOccName o, nameModule e) |
+ (o, e) <- Map.toList env ]
+
+getDocEnv :: BinHandle -> IO (Map Name Name)
+getDocEnv bh = do
+ list <- get bh
+ return (Map.fromList [(mkName mdl1 occ, mkName mdl2 occ) |
+ (mdl1,occ,mdl2) <- list])
+
+mkName mdl occ = mkExternalName (mkUnique 'X' 0) mdl occ Nothing noSrcLoc
+
+type Interface = ([Module], Map Name Name)
+
+readInterface :: FilePath -> IO Interface
+readInterface fileName = do
+ bh <- readBinMem fileName
+ formatVersion <- get bh
+ case formatVersion of
+ v | v == thisFormatVersion -> do
+ modules::[Module] <- get bh
+ env <- getDocEnv bh
+ return (modules, env)
+-- v | v == mkFormatVersion 2 -> do
+-- (stuff :: [StoredInterface2]) <- get bh
+-- return ([], Map.empty)
+-- doc_env <- getDocEnv bh
+-- return (map toInterface2 stuff, doc_env)
+ otherwise -> do
+ noDieMsg (
+ "Warning: The interface file " ++ show fileName
+ ++ " could not be read.\n"
+ ++ "Interface files from earlier version of Haddock are not "
+ ++ "supported yet.\n")
+ return ([],Map.empty)
+
+encodeNS n
+ | isVarOcc n = 0
+ | isDataOcc n = 1
+ | isTvOcc n = 2
+ | isTcOcc n = 3
+
+decodeNS n = case n of
+ 0 -> varName
+ 1 -> dataName
+ 2 -> tvName
+ _ -> tcClsName
+
+instance Binary OccName where
+ put_ bh n = do
+ put_ bh (occNameString n)
+ putByte bh (encodeNS n)
+ get bh = do
+ string <- get bh
+ ns <- getByte bh
+ return (mkOccName (decodeNS ns) string)
+
+instance Binary Module where
+ put_ bh m = do
+ put_ bh (moduleString m)
+ put_ bh ((packageIdString . modulePackageId) m)
+ get bh = do
+ m <- get bh
+ p <- get bh
+ return (mkModule (stringToPackageId p) (mkModuleName m))
+
+------------------------------------------------------------------------------
+-- Reading old interface formats
+------------------------------------------------------------------------------
+
+type StoredInterface2 =
+ (Module2, Maybe Doc2, Maybe String, Bool,
+ [(HsName, Module2)], [(HsName, [HsName])])
+
+newtype Module2 = Module2 String
+ deriving (Eq,Ord)
+
+data HsQName
+ = Qual Module HsName
+ | UnQual HsName
+ deriving (Eq,Ord)
+
+data HsName
+ = HsTyClsName HsIdentifier
+ | HsVarName HsIdentifier
+ deriving (Eq,Ord)
+
+data HsIdentifier
+ = HsIdent String
+ | HsSymbol String
+ | HsSpecial String
+ deriving (Eq,Ord)
+
+data GenDoc id
+ = DocEmpty
+ | DocAppend (GenDoc id) (GenDoc id)
+ | DocString String
+ | DocParagraph (GenDoc id)
+ | DocIdentifier id
+ | DocModule String
+ | DocEmphasis (GenDoc id)
+ | DocMonospaced (GenDoc id)
+ | DocUnorderedList [GenDoc id]
+ | DocOrderedList [GenDoc id]
+ | DocDefList [(GenDoc id, GenDoc id)]
+ | DocCodeBlock (GenDoc id)
+ | DocURL String
+ | DocAName String
+ deriving (Eq, Show)
+
+type Doc2 = GenDoc [HsQName]
+
+------------------------------------------------------------------------------
+-- Binary instances for stuff
+------------------------------------------------------------------------------
+
+instance Binary Module2 where
+ put_ bh (Module2 m) = putString bh m
+ get bh = do m <- getString bh; return $! (Module2 m)
+
+instance Binary HsQName where
+ put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s
+ put_ bh (UnQual s) = do putByte bh 1; put_ bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do m <- get bh; s <- get bh; return (Qual m s)
+ _ -> do s <- get bh; return (UnQual s)
+
+instance Binary HsName where
+ put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s
+ put_ bh (HsVarName s) = do putByte bh 1; put_ bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do s <- get bh; return (HsTyClsName s)
+ _ -> do s <- get bh; return (HsVarName s)
+
+instance Binary HsIdentifier where
+ put_ bh (HsIdent s) = do putByte bh 0; putString bh s
+ put_ bh (HsSymbol s) = do putByte bh 1; putString bh s
+ put_ bh (HsSpecial s) = do putByte bh 2; putString bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> do s <- getString bh; return (HsIdent s)
+ 1 -> do s <- getString bh; return (HsSymbol s)
+ _ -> do s <- getString bh; return (HsSpecial s)
+
+instance Binary id => Binary (GenDoc id) where
+ put_ bh DocEmpty = putByte bh 0
+ put_ bh (DocAppend gd1 gd2) = do putByte bh 1;put_ bh gd1;put_ bh gd2
+ put_ bh (DocString s) = do putByte bh 2;putString bh s
+ put_ bh (DocParagraph gd) = do putByte bh 3;put_ bh gd
+ put_ bh (DocIdentifier id) = do putByte bh 4;put_ bh id
+ put_ bh (DocModule s) = do putByte bh 5;putString bh s
+ put_ bh (DocEmphasis gd) = do putByte bh 6;put_ bh gd
+ put_ bh (DocMonospaced gd) = do putByte bh 7;put_ bh gd
+ put_ bh (DocUnorderedList gd) = do putByte bh 8;put_ bh gd
+ put_ bh (DocOrderedList gd) = do putByte bh 9;put_ bh gd
+ put_ bh (DocDefList gd) = do putByte bh 10;put_ bh gd
+ put_ bh (DocCodeBlock gd) = do putByte bh 11;put_ bh gd
+ put_ bh (DocURL s) = do putByte bh 12;putString bh s
+ put_ bh (DocAName s) = do putByte bh 13;putString bh s
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> return DocEmpty
+ 1 -> do gd1 <- get bh;gd2 <- get bh;return (DocAppend gd1 gd2)
+ 2 -> do s <- getString bh;return (DocString s)
+ 3 -> do gd <- get bh;return (DocParagraph gd)
+ 4 -> do id <- get bh;return (DocIdentifier id)
+ 5 -> do s <- getString bh;return (DocModule s)
+ 6 -> do gd <- get bh;return (DocEmphasis gd)
+ 7 -> do gd <- get bh;return (DocMonospaced gd)
+ 8 -> do gd <- get bh;return (DocUnorderedList gd)
+ 9 -> do gd <- get bh;return (DocOrderedList gd)
+ 10 -> do gd <- get bh;return (DocDefList gd)
+ 11 -> do gd <- get bh;return (DocCodeBlock gd)
+ 12 -> do s <- getString bh;return (DocURL s)
+ 13 -> do s <- getString bh;return (DocAName s)
+ _ -> error ("Mysterious byte in document in interface"
+ ++ show b)
+
+{-
+-- | How we store interfaces. Not everything is stored.
+type StoredInterface1 =
+ (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 :: [Interface] -> Map HsQName HsQName -> FilePath -> IO ()
+dumpInterfaces interfaces global_doc_env fileName =
+ do
+ let
+ preparedInterfaces :: [StoredInterface2]
+ preparedInterfaces = map from_interface interfaces
+
+ bh <- openBinMem 100000
+ put_ bh thisFormatVersion
+ put_ bh preparedInterfaces
+ putDocEnv bh global_doc_env
+ writeBinMem bh fileName
+
+
+readIface :: FilePath -> IO ([Interface], Map HsQName HsQName)
+readIface fileName = do
+ bh <- readBinMem fileName
+ formatVersion <- get bh
+ case formatVersion of
+ v | v == thisFormatVersion -> do
+ (stuff :: [StoredInterface2]) <- get bh
+ doc_env <- getDocEnv bh
+ return (map to_interface2 stuff, doc_env)
+ v | v == mkFormatVersion 1 -> do
+ (stuff :: [StoredInterface1]) <- get bh
+ return (map to_interface1 stuff, Map.empty)
+ v | v == nullFormatVersion -> do
+ (stuff :: [NullVersionStoredInterface]) <- get bh
+ return (map nullVersion_to_interface stuff, Map.empty)
+ otherwise -> do
+ noDieMsg (
+ "Warning: The interface file " ++ show fileName
+ ++ " could not be read.\n"
+ ++ "Maybe it's from a later version of Haddock?\n")
+ return ([], Map.empty)
+
+from_interface :: Interface -> StoredInterface2
+from_interface iface =
+ ( iface_module iface,
+ toDescription iface,iface_package iface,
+ OptHide `elem` iface_options iface,
+ [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface),
+ if n /= n' then error "help!" else True],
+ Map.toAscList (iface_sub iface)
+ )
+
+getDocEnv :: BinHandle -> IO (Map HsQName HsQName)
+getDocEnv bh = do
+ doc_env_list <- get bh
+ return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) |
+ (mdl1,nm,mdl2) <- doc_env_list])
+
+to_interface1 :: StoredInterface1 -> Interface
+to_interface1 (mdl,descriptionOpt,package, hide, env, _, sub) =
+ Interface {
+ iface_module = mdl,
+ iface_filename = "",
+ iface_orig_filename= "",
+ iface_package = package,
+ iface_env = Map.fromList env,
+ iface_sub = Map.fromList sub,
+ iface_reexported = [],
+ iface_exports = [],
+ iface_orig_exports = [],
+ iface_insts = [],
+ iface_decls = Map.empty,
+ iface_info = toModuleInfo descriptionOpt,
+ iface_doc = Nothing,
+ iface_options = if hide then [OptHide] else []
+ }
+
+to_interface2 :: StoredInterface2 -> Interface
+to_interface2 (mdl,descriptionOpt,package, hide, env, sub) =
+ Interface {
+ iface_module = mdl,
+ iface_filename = "",
+ iface_orig_filename= "",
+ iface_package = package,
+ iface_env =
+ Map.fromList [(n,Qual mdl n) | (n,mdl) <- env],
+ iface_sub = Map.fromList sub,
+ iface_reexported = [],
+ iface_exports = [],
+ iface_orig_exports = [],
+ iface_insts = [],
+ iface_decls = Map.empty,
+ iface_info = toModuleInfo descriptionOpt,
+ iface_doc = Nothing,
+ iface_options = if hide then [OptHide] else []
+ }
+
+nullVersion_to_interface :: NullVersionStoredInterface -> Interface
+nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =
+ Interface {
+ iface_module = mdl,
+ iface_filename = "",
+ iface_orig_filename= "",
+ iface_package = package,
+ iface_env = Map.fromList env,
+ iface_sub = Map.fromList sub,
+ iface_reexported = [],
+ iface_exports = [],
+ iface_orig_exports = [],
+ iface_insts = [],
+ iface_decls = Map.empty,
+ iface_info = emptyModuleInfo,
+ iface_doc = Nothing,
+ iface_options = if hide then [OptHide] else []
+ }
+
+toModuleInfo :: Maybe Doc -> ModuleInfo
+toModuleInfo descriptionOpt =
+ emptyModuleInfo {description = descriptionOpt}
+
+-}
diff --git a/src/Main.hs b/src/Main.hs
index 44d18f25..29e91591 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -13,50 +13,53 @@ import HaddockRename
import HaddockTypes
import HaddockUtil
import HaddockVersion
-import Paths_haddock ( getDataDir )
-import Binary2
+import Paths_haddock ( getDataDir )
+import Interface ( Interface, dumpInterface, readInterface )
-import Control.Exception ( bracket, throwIO, catch, Exception(..) )
import Prelude hiding ( catch )
-import Control.Monad ( when, liftM )
-import Control.Monad.Writer ( Writer, runWriter, tell )
-import Data.Char ( isSpace )
-import Data.IORef ( writeIORef )
-import Data.List ( nub, (\\), foldl', sortBy, foldl1, init, mapAccumL, find )
-import Data.Maybe ( isJust, isNothing, maybeToList, listToMaybe )
---import Debug.Trace
-import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) )
-import System.Environment ( getArgs )
-import System.IO ( stderr, IOMode(..), openFile, hClose, hGetContents, hPutStrLn )
-import System.Directory ( doesFileExist, doesDirectoryExist )
+import Control.Exception ( bracket, throwIO, catch, Exception(..) )
+import Control.Monad ( when, liftM )
+import Control.Monad.Writer ( Writer, runWriter, tell )
+import Data.Char ( isSpace )
+import Data.IORef ( writeIORef )
+import Data.List ( nub, nubBy, (\\), foldl', sortBy, foldl1, init,
+ mapAccumL, find )
+import Data.Maybe ( Maybe(..), isJust, isNothing, maybeToList,
+ listToMaybe, fromJust, catMaybes )
+import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..),
+ ArgDescr(..) )
+import System.Environment ( getArgs )
+import System.IO ( stderr, IOMode(..), openFile, hClose,
+ hGetContents, hPutStrLn )
+import System.Directory ( doesFileExist, doesDirectoryExist )
#if defined(mingw32_HOST_OS)
import Foreign
import Foreign.C
#endif
import qualified Data.Map as Map
-import Data.Map (Map)
-import Data.Maybe
-import Data.List ( nubBy )
-import Data.FunctorM ( fmapM )
+import Data.Map (Map)
+import Data.FunctorM ( fmapM )
-import qualified GHC ( init )
-import GHC hiding ( init )
+import qualified GHC ( init )
+import GHC hiding ( init )
import Outputable
import SrcLoc
import qualified Digraph as Digraph
import Name
-import Module ( mkModule )
+import Module ( mkModule )
import InstEnv
import Class
import TypeRep
import Var hiding ( varName )
import TyCon
import PrelNames
+
import FastString
#define FSLIT(x) (mkFastString# (x#))
+
import DynFlags hiding ( Option )
-import StaticFlags ( parseStaticFlags )
-import Unique ( mkUnique )
+import StaticFlags ( parseStaticFlags )
+import Unique ( mkUnique )
import Packages
-----------------------------------------------------------------------------
@@ -130,17 +133,16 @@ parseGHCFlag dynflags args = do
Just (_, rest) -> return (Nothing, rest)
Nothing -> die ("Not a GHC flag: " ++ (head args) ++ "\n")
where
- findDynamic = findFlag (
- \xs ->
- (do
- (fs, xs') <- parseDynamicFlags dynflags xs
- if xs' /= xs then return (Just fs) else return Nothing
- )
- `catch` (\_ -> return Nothing)
+ findDynamic = findFlag (\xs -> (do
+ (fs, xs') <- parseDynamicFlags dynflags xs
+ if xs' /= xs then return (Just fs) else return Nothing
+ ) `catch` (\_ -> return Nothing)
)
+
findStatic = findFlag (\xs -> do
- xs' <- parseStaticFlags xs
- if xs /= xs' then return (Just ()) else return Nothing)
+ xs' <- parseStaticFlags xs
+ if xs /= xs' then return (Just ()) else return Nothing
+ )
findFlag p = do
xs <- (sequence . snd) (mapAccumL (f p) [] args)
@@ -219,8 +221,17 @@ getIfacesAndHtmls flags dynflags = do
readIfaceFlags = [ parseIfaceOption str | Flag_ReadInterface str <- flags ]
totalFiles = packageFiles ++ readIfaceFlags
(htmlPaths, ifacePaths) = unzip totalFiles
- ifaces <- mapM readIface ifacePaths
- return (ifaces, htmlPaths)
+ files <- mapM (\(htmlPath, ifacePath) -> do
+ htmlExist <- doesDirectoryExist htmlPath
+ ifaceExist <- doesFileExist ifacePath
+ if htmlExist && ifaceExist
+ then do
+ iface <- readInterface ifacePath
+ return (Just (iface, htmlPath))
+ else return Nothing
+ ) totalFiles
+
+ return (unzip (catMaybes files))
data Flag
= Flag_CSS String
@@ -436,7 +447,7 @@ run flags modules extEnvs = do
-- dump an interface if requested
case dumpIface of
Nothing -> return ()
- Just fn -> dumpInterfaces env (map hmod_mod visibleMods) fn
+ Just fn -> dumpInterface env (map hmod_mod visibleMods) fn
where
pprList [] = []
pprList [x] = show x
@@ -901,7 +912,6 @@ pruneExportItems items = filter hasDoc items
where hasDoc (ExportDecl2 _ _ d _) = isJust d
hasDoc _ = True
-
-- -----------------------------------------------------------------------------
-- Gather a list of original names exported from this module
@@ -1131,8 +1141,9 @@ toHsType t = case t of
type ErrMsg = String
type ErrMsgM a = Writer [ErrMsg] a
--- -----------------------------------------------------------------------------
+--------------------------------------------------------------------------------
-- Packages
+--------------------------------------------------------------------------------
getPackageFiles :: DynFlags -> IO [(String, String)]
getPackageFiles dynflags = do
@@ -1171,221 +1182,3 @@ getPackageFiles dynflags = do
first [] = []
first (x:_) = x
-
--- -----------------------------------------------------------------------------
--- The interface file format
--- ehhm. this is a temporary hack...
-
-thisFormatVersion :: FormatVersion
-thisFormatVersion = mkFormatVersion 3
-
-dumpInterfaces :: Map Name Name -> [Module] -> FilePath -> IO ()
-dumpInterfaces globalDocEnv modules fileName = do
- bh <- openBinMem 100000
- put_ bh thisFormatVersion
- mapM (put_ bh) modules
- putDocEnv bh globalDocEnv
- writeBinMem bh fileName
-
-putDocEnv :: BinHandle -> Map Name Name -> IO ()
-putDocEnv bh env = put_ bh list
- where
- list = [ (nameModule o, nameOccName o, nameModule e) |
- (o, e) <- Map.toList env ]
-
-getDocEnv :: BinHandle -> IO (Map Name Name)
-getDocEnv bh = do
- list <- get bh
- return (Map.fromList [(mkName mdl1 occ, mkName mdl2 occ) |
- (mdl1,occ,mdl2) <- list])
-
-mkName mdl occ = mkExternalName (mkUnique 'X' 0) mdl occ Nothing noSrcLoc
-
---type StoredInterface2 =
--- (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)], [(HsName,[HsName])])
-
-type Interface = ([Module], Map Name Name)
-
-readIface :: FilePath -> IO Interface
-readIface fileName = do
- bh <- readBinMem fileName
- formatVersion <- get bh
- case formatVersion of
- v | v == thisFormatVersion -> do
- modules::[Module] <- get bh
- env <- getDocEnv bh
- return (modules, env)
--- v | v == mkFormatVersion 2 -> do
--- (stuff :: [StoredInterface2]) <- get bh
--- doc_env <- getDocEnv bh
--- return (map to_interface2 stuff, doc_env)
- otherwise -> do
- noDieMsg (
- "Warning: The interface file " ++ show fileName
- ++ " could not be read.\n"
- ++ "Interface files from earlier version of Haddock are not "
- ++ "supported yet.\n")
- return ([],Map.empty)
-
-encodeNS n
- | isVarOcc n = 0
- | isDataOcc n = 1
- | isTvOcc n = 2
- | isTcOcc n = 3
-
-decodeNS n = case n of
- 0 -> varName
- 1 -> dataName
- 2 -> tvName
- _ -> tcClsName
-
-instance Binary OccName where
- put_ bh n = do
- put_ bh (occNameString n)
- putByte bh (encodeNS n)
- get bh = do
- string <- get bh
- ns <- getByte bh
- return (mkOccName (decodeNS ns) string)
-
-instance Binary Module where
- put_ bh m = do
- put_ bh (moduleString m)
- put_ bh ((packageIdString . modulePackageId) m)
- get bh = do
- m <- get bh
- p <- get bh
- return (mkModule (stringToPackageId p) (mkModuleName m))
-{-
-thisFormatVersion :: FormatVersion
-thisFormatVersion = mkFormatVersion 2
-
--- | How we store interfaces. Not everything is stored.
-type StoredInterface2 =
- (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)], [(HsName,[HsName])])
-
--- | How we store interfaces. Not everything is stored.
-type StoredInterface1 =
- (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 :: [Interface] -> Map HsQName HsQName -> FilePath -> IO ()
-dumpInterfaces interfaces global_doc_env fileName =
- do
- let
- preparedInterfaces :: [StoredInterface2]
- preparedInterfaces = map from_interface interfaces
-
- bh <- openBinMem 100000
- put_ bh thisFormatVersion
- put_ bh preparedInterfaces
- putDocEnv bh global_doc_env
- writeBinMem bh fileName
-
-
-readIface :: FilePath -> IO ([Interface], Map HsQName HsQName)
-readIface fileName = do
- bh <- readBinMem fileName
- formatVersion <- get bh
- case formatVersion of
- v | v == thisFormatVersion -> do
- (stuff :: [StoredInterface2]) <- get bh
- doc_env <- getDocEnv bh
- return (map to_interface2 stuff, doc_env)
- v | v == mkFormatVersion 1 -> do
- (stuff :: [StoredInterface1]) <- get bh
- return (map to_interface1 stuff, Map.empty)
- v | v == nullFormatVersion -> do
- (stuff :: [NullVersionStoredInterface]) <- get bh
- return (map nullVersion_to_interface stuff, Map.empty)
- otherwise -> do
- noDieMsg (
- "Warning: The interface file " ++ show fileName
- ++ " could not be read.\n"
- ++ "Maybe it's from a later version of Haddock?\n")
- return ([], Map.empty)
-
-from_interface :: Interface -> StoredInterface2
-from_interface iface =
- ( iface_module iface,
- toDescription iface,iface_package iface,
- OptHide `elem` iface_options iface,
- [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface),
- if n /= n' then error "help!" else True],
- Map.toAscList (iface_sub iface)
- )
-
-getDocEnv :: BinHandle -> IO (Map HsQName HsQName)
-getDocEnv bh = do
- doc_env_list <- get bh
- return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) |
- (mdl1,nm,mdl2) <- doc_env_list])
-
-to_interface1 :: StoredInterface1 -> Interface
-to_interface1 (mdl,descriptionOpt,package, hide, env, _, sub) =
- Interface {
- iface_module = mdl,
- iface_filename = "",
- iface_orig_filename= "",
- iface_package = package,
- iface_env = Map.fromList env,
- iface_sub = Map.fromList sub,
- iface_reexported = [],
- iface_exports = [],
- iface_orig_exports = [],
- iface_insts = [],
- iface_decls = Map.empty,
- iface_info = toModuleInfo descriptionOpt,
- iface_doc = Nothing,
- iface_options = if hide then [OptHide] else []
- }
-
-to_interface2 :: StoredInterface2 -> Interface
-to_interface2 (mdl,descriptionOpt,package, hide, env, sub) =
- Interface {
- iface_module = mdl,
- iface_filename = "",
- iface_orig_filename= "",
- iface_package = package,
- iface_env =
- Map.fromList [(n,Qual mdl n) | (n,mdl) <- env],
- iface_sub = Map.fromList sub,
- iface_reexported = [],
- iface_exports = [],
- iface_orig_exports = [],
- iface_insts = [],
- iface_decls = Map.empty,
- iface_info = toModuleInfo descriptionOpt,
- iface_doc = Nothing,
- iface_options = if hide then [OptHide] else []
- }
-
-nullVersion_to_interface :: NullVersionStoredInterface -> Interface
-nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =
- Interface {
- iface_module = mdl,
- iface_filename = "",
- iface_orig_filename= "",
- iface_package = package,
- iface_env = Map.fromList env,
- iface_sub = Map.fromList sub,
- iface_reexported = [],
- iface_exports = [],
- iface_orig_exports = [],
- iface_insts = [],
- iface_decls = Map.empty,
- iface_info = emptyModuleInfo,
- iface_doc = Nothing,
- iface_options = if hide then [OptHide] else []
- }
-
-toModuleInfo :: Maybe Doc -> ModuleInfo
-toModuleInfo descriptionOpt =
- emptyModuleInfo {description = descriptionOpt}
-
--}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 00:54:18 +0000