[haddock @ 2003-07-28 14:32:42 by simonmar]

Update to avoid using hslibs with GHC >= 5.04

10 files changed, 134 insertions, 31 deletions

diff --git a/src/Binary.hs b/src/Binary.hs
index c5fb294e..6ac9db1c 100644
--- a/src/Binary.hs
+++ b/src/Binary.hs
@@ -56,6 +56,10 @@ module Binary
 
 import FastMutInt
 
+import Char
+import Monad
+
+#if __GLASGOW_HASKELL__ < 503
 import IOExts
 import Bits
 import Int
@@ -64,42 +68,68 @@ import Char
 import Monad
 import Exception
 import GlaExts hiding (ByteArray, newByteArray, freezeByteArray)
+import Array
 import IO
-#if __GLASGOW_HASKELL__ < 503
-import PrelIOBase	--	( IOError(..), IOErrorType(..) )
-import PrelReal		--	( Ratio(..) )
-import PrelIOBase	-- 	( IO(..) )
+import PrelIOBase		( IOError(..), IOErrorType(..)
+#if __GLASGOW_HASKELL__ > 411
+				, IOException(..)
+#endif
+				)
+import PrelReal			( Ratio(..) )
+import PrelIOBase	 	( IO(..) )
 #else
-import System.IO.Error ( mkIOError, eofErrorType )
-import GHC.Real ( Ratio(..) )
-import GHC.IOBase ( IO(..) )
+import Data.Array.IO
+import Data.Array
+import Data.Bits
+import Data.Int
+import Data.Word
+import Data.IORef
+import Data.Char		( ord, chr )
+import Data.Array.Base  	( unsafeRead, unsafeWrite )
+import Control.Monad		( when )
+import Control.Exception	( throwDyn )
+import System.IO as IO
+import System.IO.Unsafe		( unsafeInterleaveIO )
+import System.IO.Error		( mkIOError, eofErrorType )
+import GHC.Real			( Ratio(..) )
+import GHC.Exts
+import GHC.IOBase	 	( IO(..) )
+import GHC.Word			( Word8(..) )
+#if __GLASGOW_HASKELL__ < 601
+-- openFileEx is available from the lang package, but we want to 
+-- be independent of hslibs libraries.
+import GHC.Handle		( openFileEx, IOModeEx(..) )
+#else
+import System.IO		( openBinaryFile )
+#endif
+#endif
+
+import IO
+
+#if __GLASGOW_HASKELL__ < 601
+openBinaryFile f mode = openFileEx f (BinaryMode mode)
 #endif
 
+#if __GLASGOW_HASKELL__ < 503
 type BinArray = MutableByteArray RealWorld Int
-newArray_ :: Ix ix => (ix, ix) -> IO (MutableByteArray RealWorld ix)
 newArray_ bounds     = stToIO (newCharArray bounds)
-
-unsafeWrite :: Ix ix => MutableByteArray RealWorld ix -> ix -> Word8 -> IO ()
 unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e)
-
-unsafeRead :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
 unsafeRead  arr ix   = stToIO (readWord8Array arr ix)
+#if __GLASGOW_HASKELL__ < 411
+newByteArray#        = newCharArray#
+#endif
+hPutArray h arr sz   = hPutBufBAFull h arr sz
+hGetArray h sz       = hGetBufBAFull h sz
 
-hPutArray :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
-hPutArray h arr sz   = hPutBufBA h arr sz
-
-hGetArray :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
-hGetArray h sz       = hGetBufBA h sz
-
-#if __GLASGOW_HASKELL__ < 503
 mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception
 mkIOError t location maybe_hdl maybe_filename
   = IOException (IOError maybe_hdl t location ""
+#if __GLASGOW_HASKELL__ > 411
 		         maybe_filename
+#endif
   		)
 
 eofErrorType = EOF
-#endif
 
 #ifndef SIZEOF_HSINT
 #define SIZEOF_HSINT  INT_SIZE_IN_BYTES
@@ -109,7 +139,9 @@ eofErrorType = EOF
 #define SIZEOF_HSWORD WORD_SIZE_IN_BYTES
 #endif
 
---type BinArray = IOUArray Int Word8
+#else
+type BinArray = IOUArray Int Word8
+#endif
 
 data BinHandle
   = BinMem {		-- binary data stored in an unboxed array
@@ -204,7 +236,7 @@ isEOFBin (BinIO _ _ h) = hIsEOF h
 writeBinMem :: BinHandle -> FilePath -> IO ()
 writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
 writeBinMem (BinMem _ ix_r _ arr_r0) fn = do
-  h <- openFileEx fn (BinaryMode WriteMode)
+  h <- openBinaryFile fn WriteMode
   arr <- readIORef arr_r0
   ix  <- readFastMutInt ix_r
   hPutArray h arr ix
diff --git a/src/Digraph.lhs b/src/Digraph.lhs
index 6bf8de7b..a7a04d49 100644
--- a/src/Digraph.lhs
+++ b/src/Digraph.lhs
@@ -39,7 +39,12 @@ module Digraph(
 #define ARR_ELT		(COMMA)
 
 -- Extensions
+#if __GLASGOW_HASKELL__ < 503
 import ST
+#else
+import Control.Monad.ST
+import Data.Array.ST hiding (indices,bounds)
+#endif
 
 -- std interfaces
 import Maybe
@@ -233,6 +238,17 @@ draw (Node x ts0) = grp this (space (length this)) (stLoop ts0)
 %************************************************************************
 
 \begin{code}
+#if __GLASGOW_HASKELL__ >= 504
+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
+newSTArray = newArray
+
+readSTArray :: Ix i => STArray s i e -> i -> ST s e
+readSTArray = readArray
+
+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
+writeSTArray = writeArray
+#endif
+
 type Set s    = STArray s Vertex Bool
 
 mkEmpty      :: Bounds -> ST s (Set s)
diff --git a/src/HaddockDB.hs b/src/HaddockDB.hs
index ebd0ccb2..f1718149 100644
--- a/src/HaddockDB.hs
+++ b/src/HaddockDB.hs
@@ -10,8 +10,14 @@ import HaddockTypes
 import HaddockUtil
 
 import HsSyn
+
+#if __GLASGOW_HASKELL__ < 503
 import Pretty
 import FiniteMap
+#else
+import Text.PrettyPrint
+import Data.FiniteMap
+#endif
 
 -----------------------------------------------------------------------------
 -- Printing the results in DocBook format
diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs
index d1c0f486..9357c00c 100644
--- a/src/HaddockHH.hs
+++ b/src/HaddockHH.hs
@@ -1,8 +1,15 @@
 module HaddockHH(ppHHContents, ppHHIndex) where
 
 import HsSyn hiding(Doc)
+
+#if __GLASGOW_HASKELL__ < 503
 import Pretty
 import FiniteMap
+#else
+import Text.PrettyPrint
+import Data.FiniteMap
+#endif
+
 import HaddockModuleTree
 import HaddockUtil
 import HaddockTypes
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 44663821..7275e948 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -16,11 +16,17 @@ import HsSyn
 
 import IO
 import Maybe	( fromJust, isJust )
-import FiniteMap
 import List 	( sortBy )
 import Char	( toUpper, toLower, isAlpha, ord )
 import Monad	( when, unless )
+
+#if __GLASGOW_HASKELL__ < 503
+import FiniteMap
 import URI	( escapeString, unreserved )
+#else
+import Data.FiniteMap
+import Network.URI ( escapeString, unreserved )
+#endif
 
 import Html
 import qualified Html
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index b539e9ff..1a2ab04e 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -16,7 +16,12 @@ module HaddockRename (
 import HaddockTypes
 import HsSyn
 
+#if __GLASGOW_HASKELL__ < 503
 import FiniteMap
+#else
+import Data.FiniteMap
+#endif
+
 import Monad
 
 -- -----------------------------------------------------------------------------
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index 36cb9351..cc6585bc 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -12,7 +12,12 @@ module HaddockTypes (
   DocOption(..), InstHead,
  ) where
 
+#if __GLASGOW_HASKELL__ < 503
 import FiniteMap
+#else
+import Data.FiniteMap
+#endif
+
 import HsSyn
 
 -- ---------------------------------------------------------------------------
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 61c40373..9804fb6e 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -26,16 +26,24 @@ module HaddockUtil (
 
 import HsSyn
 
-import FiniteMap
 import List	( intersect )
 import Maybe
 import IO	( hPutStr, stderr )
 import System
-import RegexString
 import Binary
-import IOExts
 import Monad
 
+#if __GLASGOW_HASKELL__ < 503
+import RegexString
+import FiniteMap
+import IOExts
+#else
+import Text.Regex
+import Data.FiniteMap
+import Data.IORef
+import System.IO.Unsafe	 ( unsafePerformIO )
+#endif
+
 -- -----------------------------------------------------------------------------
 -- Some Utilities
 
@@ -167,7 +175,11 @@ declDoc _ = Nothing
 parseModuleHeader :: String -> (String, Maybe ModuleInfo)
 parseModuleHeader str =
   case matchRegexAll moduleHeaderRE str of
+#if __GLASGOW_HASKELL__ < 503
 	Just (_, _, after, _, (_:_:_:s1:s2:s3:_)) -> 
+#else
+	Just (_, _, after, (_:_:_:s1:s2:s3:_)) -> 
+#endif
 	   (after, Just (ModuleInfo { 
 				 portability = s3,
 				 stability   = s2,
diff --git a/src/Main.hs b/src/Main.hs
index d1bd8e51..092c4861 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,9 +20,7 @@ import Binary
 import HsParser
 import HsParseMonad
 import HsSyn
-import GetOpt
 import System
-import FiniteMap
 
 --import Pretty
 
@@ -32,12 +30,20 @@ import Monad	( when )
 import Char	( isSpace )
 import IO
 
-#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ < 503
+import MonadWriter
+import FiniteMap
+import GetOpt
 import IOExts
+#else
+import Control.Monad.Writer
+import Data.FiniteMap
+import System.Console.GetOpt
+import Data.IORef
+import Debug.Trace
+import System.IO.Unsafe	 ( unsafePerformIO )
 #endif
 
-import MonadWriter
-
 #if __GLASGOW_HASKELL__ < 500
 import Regex
 import PackedString
diff --git a/src/Makefile b/src/Makefile
index 5064025b..c7685e92 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -3,7 +3,15 @@ include $(TOP)/mk/boilerplate.mk
 
 INSTALLING=1
 
+ghc_ge_504 = $(shell if (test $(GhcCanonVersion) -ge 504); then echo YES; else echo NO; fi)
+
+# Don't use any hslibs packages in GHC >= 5.04
+ifeq "$(ghc_ge_504)" "YES"
+SRC_HC_OPTS += -package network -fglasgow-exts -cpp
+else
 SRC_HC_OPTS += -package data -package text -package util -package net -fglasgow-exts -cpp
+endif
+
 HS_PROG = haddock.bin
 
 HsParser_HC_OPTS      += -Onot