diff options
| -rw-r--r-- | haddock.cabal | 1 | ||||
| -rw-r--r-- | src/Interface.hs | 345 | ||||
| -rw-r--r-- | src/Main.hs | 303 |
3 files changed, 394 insertions, 255 deletions
diff --git a/haddock.cabal b/haddock.cabal index a9749119..25eb56a7 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -71,5 +71,6 @@ other-modules: HaddockTypes HaddockUtil HaddockVersion + Interface Html Main 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} - --} |