diff options
Diffstat (limited to 'src/Haddock/InterfaceFile.hs')
-rw-r--r-- | src/Haddock/InterfaceFile.hs | 72 |
1 files changed, 38 insertions, 34 deletions
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index 7f2fd6f4..93d6fe4c 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -114,47 +114,51 @@ writeInterfaceFile filename iface = do -- snd send the result to the file writeBinMem bh filename return () + -readInterfaceFile :: FilePath -> IO InterfaceFile +readInterfaceFile :: FilePath -> IO (Either String InterfaceFile) readInterfaceFile filename = do bh <- readBinMem filename - magic <- get bh - when (magic /= binaryInterfaceMagic) $ throwE $ - "Magic number mismatch: couldn't load interface file: " ++ filename - + magic <- get bh version <- get bh - when (version /= binaryInterfaceVersion) $ throwE $ - "Interface file is of wrong version: " ++ filename - -- get the dictionary - dict_p <- get bh - data_p <- tellBin bh - seekBin bh dict_p - dict <- getDictionary bh - seekBin bh data_p - - -- initialise the user-data field of bh - ud <- newReadState dict - bh <- return (setUserData bh ud) + case () of + _ | magic /= binaryInterfaceMagic -> return . Left $ + "Magic number mismatch: couldn't load interface file: " ++ filename + | version /= binaryInterfaceVersion -> return . Left $ + "Interface file is of wrong version: " ++ filename + | otherwise -> do + + -- get the dictionary + dict_p <- get bh + data_p <- tellBin bh + seekBin bh dict_p + dict <- getDictionary bh + seekBin bh data_p + + -- initialise the user-data field of bh + ud <- newReadState dict + bh <- return (setUserData bh ud) - -- get the symbol table - symtab_p <- get bh - data_p <- tellBin bh - seekBin bh symtab_p - -- (construct an empty name cache) - u <- mkSplitUniqSupply 'a' -- ?? - let nc = initNameCache u [] - (_, symtab) <- getSymbolTable bh nc - seekBin bh data_p - - -- set the symbol table - let ud = getUserData bh - bh <- return $! setUserData bh ud{ud_symtab = symtab} - - -- load the actual data - iface <- get bh - return iface + -- get the symbol table + symtab_p <- get bh + data_p <- tellBin bh + seekBin bh symtab_p + -- (construct an empty name cache) + u <- mkSplitUniqSupply 'a' -- ?? + let nc = initNameCache u [] + (_, symtab) <- getSymbolTable bh nc + seekBin bh data_p + + -- set the symbol table + let ud = getUserData bh + bh <- return $! setUserData bh ud{ud_symtab = symtab} + + -- load the actual data + iface <- get bh + return (Right iface) + ------------------------------------------------------------------------------- -- Symbol table |