From 6cfeee53431768f8d8326d6c645d6ccda198bde0 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 28 Jul 2003 14:32:43 +0000 Subject: [haddock @ 2003-07-28 14:32:42 by simonmar] Update to avoid using hslibs with GHC >= 5.04 --- src/Binary.hs | 76 +++++++++++++++++++++++++++++++++++++--------------- src/Digraph.lhs | 16 +++++++++++ src/HaddockDB.hs | 6 +++++ src/HaddockHH.hs | 7 +++++ src/HaddockHtml.hs | 8 +++++- src/HaddockRename.hs | 5 ++++ src/HaddockTypes.hs | 5 ++++ src/HaddockUtil.hs | 18 ++++++++++--- src/Main.hs | 16 +++++++---- src/Makefile | 8 ++++++ 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 -- cgit v1.2.3