Remove Interface and Binary2 modules

1 files changed, 0 insertions, 345 deletions

diff --git a/src/Interface.hs b/src/Interface.hs
deleted file mode 100644
index 0578fe83..00000000
--- a/src/Interface.hs
+++ /dev/null
@@ -1,345 +0,0 @@
-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}
-
--}