From 6f55aa8b181d1cfcfb415a87733e530809332573 Mon Sep 17 00:00:00 2001
From: "davve@dtek.chalmers.se" <David Waern>
Date: Sun, 25 Mar 2007 00:46:48 +0000
Subject: Start work on Haddock API

---
 src/Haddock/Exception.hs     | 14 +++++++++++++
 src/Haddock/InterfaceFile.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+)
 create mode 100644 src/Haddock/Exception.hs
 create mode 100644 src/Haddock/InterfaceFile.hs

(limited to 'src/Haddock')

diff --git a/src/Haddock/Exception.hs b/src/Haddock/Exception.hs
new file mode 100644
index 00000000..73ec2c5d
--- /dev/null
+++ b/src/Haddock/Exception.hs
@@ -0,0 +1,14 @@
+module Haddock.Exception (
+  HaddockException,
+  throwE
+)where
+
+import Data.Typeable
+import Control.Exception
+
+data HaddockException = HaddockException String deriving Typeable
+throwE str = throwDyn (HaddockException str)
+
+instance Show HaddockException where
+  show (HaddockException str) = str
+  
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
new file mode 100644
index 00000000..becd40df
--- /dev/null
+++ b/src/Haddock/InterfaceFile.hs
@@ -0,0 +1,50 @@
+module Haddock.InterfaceFile (
+  InterfaceFile(..),
+  writeInterfaceFile,
+  readInterfaceFile
+) where
+
+import HaddockTypes
+import Haddock.Exception
+
+import Binary
+import System.IO
+import Data.Word
+import qualified Data.Map as Map
+import Control.Monad
+
+data InterfaceFile = InterfaceFile {
+  ifDocEnv :: DocEnv
+} 
+
+instance Binary InterfaceFile where
+  put_ bh (InterfaceFile docEnv) = put_ bh (Map.toList docEnv)
+  get bh = do
+    envList <- get bh
+    return (InterfaceFile (Map.fromList envList))
+
+packageFileMagic = 0xDA303001 :: Word32
+packageFileVersion = 0 :: Word16
+
+writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
+writeInterfaceFile filename iface = do 
+  h <- openBinaryFile filename WriteMode
+  bh <- openBinIO h
+  ud <- newWriteState
+  bh <- return $ setUserData bh ud
+  put_ bh packageFileMagic
+  put_ bh packageFileVersion
+  put_ bh iface
+  hClose h
+    
+readInterfaceFile :: FilePath -> IO InterfaceFile
+readInterfaceFile filename = do
+  h <- openBinaryFile filename ReadMode
+  bh <- openBinIO h
+  ud <- newReadState undefined
+  bh <- return (setUserData bh ud)
+  magic <- get bh
+  when (magic /= packageFileMagic) $ throwE $
+    "Magic number mismatch: couldn't load interface file: " ++ filename
+  (version :: Word16) <- get bh
+  get bh
-- 
cgit v1.2.3