aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/InterfaceFile.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/InterfaceFile.hs')
-rw-r--r--src/Haddock/InterfaceFile.hs216
1 files changed, 190 insertions, 26 deletions
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 92dc371b..e822cdda 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -7,9 +7,8 @@
module Haddock.InterfaceFile (
InterfaceFile(..),
- writeInterfaceFile,
readInterfaceFile,
- iface2interface
+ writeInterfaceFile
) where
@@ -24,8 +23,8 @@ import qualified Data.Map as Map
import System.IO
import Control.Monad
-import GHC
-import SrcLoc ( noSrcSpan ) -- tmp, GHC now exports this
+import GHC hiding (NoLink)
+import SrcLoc (noSrcSpan) -- tmp, GHC now exports this
import Binary
import Name
import UniqSupply
@@ -38,38 +37,20 @@ import FastMutInt
import InstEnv
import HsDoc
-data InterfaceMod = InterfaceMod {
- imModule :: Module,
- imFilename :: FilePath,
- imExportItems :: [ExportItem DocName]
-}
data InterfaceFile = InterfaceFile {
- ifLinkEnv :: LinkEnv,
- ifModules :: [Module]
+ ifLinkEnv :: LinkEnv,
+ ifInstalledIfaces :: [InstalledInterface]
}
-instance Binary InterfaceFile where
- put_ bh (InterfaceFile env mods) = do
- put_ bh (Map.toList env)
- put_ bh mods
- get bh = do
- env <- get bh
- mods <- get bh
- return (InterfaceFile (Map.fromList env) mods)
-
-iface2interface iface = InterfaceMod {
- imModule = ifaceMod iface,
- imFilename = ifaceOrigFilename iface,
- imExportItems = ifaceRnExportItems iface
-}
-
binaryInterfaceMagic = 0xD0Cface :: Word32
binaryInterfaceVersion = 0 :: Word16
+
initBinMemSize = (1024*1024) :: Int
+
writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
writeInterfaceFile filename iface = do
bh <- openBinMem initBinMemSize
@@ -214,3 +195,186 @@ serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name symtab = do
let mod = nameModule name
put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
+
+
+-------------------------------------------------------------------------------
+-- GhcBinary instances
+-------------------------------------------------------------------------------
+
+
+instance Binary InterfaceFile where
+ put_ bh (InterfaceFile env ifaces) = do
+ put_ bh (Map.toList env)
+ put_ bh ifaces
+
+ get bh = do
+ env <- get bh
+ ifaces <- get bh
+ return (InterfaceFile (Map.fromList env) ifaces)
+
+
+instance Binary InstalledInterface where
+ put_ bh (InstalledInterface mod info docMap exps visExps) = do
+ put_ bh mod
+ put_ bh info
+ put_ bh (Map.toList docMap)
+ put_ bh exps
+ put_ bh visExps
+
+ get bh = do
+ mod <- get bh
+ info <- get bh
+ docMap <- get bh
+ exps <- get bh
+ visExps <- get bh
+ return (InstalledInterface mod info (Map.fromList docMap) exps visExps)
+
+
+{-* Generated by DrIFT : Look, but Don't Touch. *-}
+instance Binary DocName where
+ put_ bh (Link aa) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh (NoLink ab) = do
+ putByte bh 1
+ put_ bh ab
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do
+ aa <- get bh
+ return (Link aa)
+ 1 -> do
+ ab <- get bh
+ return (NoLink ab)
+ _ -> fail "invalid binary data found"
+
+
+instance Binary DocOption where
+ put_ bh OptHide = do
+ putByte bh 0
+ put_ bh OptPrune = do
+ putByte bh 1
+ put_ bh OptIgnoreExports = do
+ putByte bh 2
+ put_ bh OptNotHome = do
+ putByte bh 3
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do
+ return OptHide
+ 1 -> do
+ return OptPrune
+ 2 -> do
+ return OptIgnoreExports
+ 3 -> do
+ return OptNotHome
+ _ -> fail "invalid binary data found"
+
+
+{-* Generated by DrIFT : Look, but Don't Touch. *-}
+instance (Binary id) => Binary (HsDoc id) where
+ put_ bh DocEmpty = do
+ putByte bh 0
+ put_ bh (DocAppend aa ab) = do
+ putByte bh 1
+ put_ bh aa
+ put_ bh ab
+ put_ bh (DocString ac) = do
+ putByte bh 2
+ put_ bh ac
+ put_ bh (DocParagraph ad) = do
+ putByte bh 3
+ put_ bh ad
+ put_ bh (DocIdentifier ae) = do
+ putByte bh 4
+ put_ bh ae
+ put_ bh (DocModule af) = do
+ putByte bh 5
+ put_ bh af
+ put_ bh (DocEmphasis ag) = do
+ putByte bh 6
+ put_ bh ag
+ put_ bh (DocMonospaced ah) = do
+ putByte bh 7
+ put_ bh ah
+ put_ bh (DocUnorderedList ai) = do
+ putByte bh 8
+ put_ bh ai
+ put_ bh (DocOrderedList aj) = do
+ putByte bh 9
+ put_ bh aj
+ put_ bh (DocDefList ak) = do
+ putByte bh 10
+ put_ bh ak
+ put_ bh (DocCodeBlock al) = do
+ putByte bh 11
+ put_ bh al
+ put_ bh (DocURL am) = do
+ putByte bh 12
+ put_ bh am
+ put_ bh (DocAName an) = do
+ putByte bh 13
+ put_ bh an
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do
+ return DocEmpty
+ 1 -> do
+ aa <- get bh
+ ab <- get bh
+ return (DocAppend aa ab)
+ 2 -> do
+ ac <- get bh
+ return (DocString ac)
+ 3 -> do
+ ad <- get bh
+ return (DocParagraph ad)
+ 4 -> do
+ ae <- get bh
+ return (DocIdentifier ae)
+ 5 -> do
+ af <- get bh
+ return (DocModule af)
+ 6 -> do
+ ag <- get bh
+ return (DocEmphasis ag)
+ 7 -> do
+ ah <- get bh
+ return (DocMonospaced ah)
+ 8 -> do
+ ai <- get bh
+ return (DocUnorderedList ai)
+ 9 -> do
+ aj <- get bh
+ return (DocOrderedList aj)
+ 10 -> do
+ ak <- get bh
+ return (DocDefList ak)
+ 11 -> do
+ al <- get bh
+ return (DocCodeBlock al)
+ 12 -> do
+ am <- get bh
+ return (DocURL am)
+ 13 -> do
+ an <- get bh
+ return (DocAName an)
+ _ -> fail "invalid binary data found"
+
+
+instance Binary name => Binary (HaddockModInfo name) where
+ put_ bh hmi = do
+ put_ bh (hmi_description hmi)
+ put_ bh (hmi_portability hmi)
+ put_ bh (hmi_stability hmi)
+ put_ bh (hmi_maintainer hmi)
+
+ get bh = do
+ descr <- get bh
+ porta <- get bh
+ stabi <- get bh
+ maint <- get bh
+ return (HaddockModInfo descr porta stabi maint)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 16:28:32 +0000