wash, ghc 6.4
Frederik Eaton
frederik at a5.repetae.net
Tue May 17 02:38:40 EDT 2005
Hi Peter,
I've attached a patch to make Wash compile under ghc-6.4. I'm guessing
you'll probably want to release a new version that *only* compiles
under 6.4, rather than try to differentiate compiler versions, so I
didn't add any logic for that. Anyway, please take a look.
Frederik
--
http://ofb.net/~frederik/
-------------- next part --------------
diff -urN WashNGo-2.3.1/cgi/CGIConfig.hs WashNGo-2.3.1-compat-6.4/cgi/CGIConfig.hs
--- WashNGo-2.3.1/cgi/CGIConfig.hs 2004-08-06 07:34:29.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/cgi/CGIConfig.hs 2005-05-16 21:06:15.000000000 -0700
@@ -1,6 +1,6 @@
module CGIConfig where
-import IOExts
+import System.IO.Unsafe
import System
tmpDir, varDir, imageDir, emailTmpDir, frameDir, persistentDir, persistent2Dir, registryDir, keyFile, pbmPath, catProgram, sendmailProgram :: String
diff -urN WashNGo-2.3.1/cgi/Debug.hs WashNGo-2.3.1-compat-6.4/cgi/Debug.hs
--- WashNGo-2.3.1/cgi/Debug.hs 2004-08-06 07:34:29.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/cgi/Debug.hs 2005-05-16 21:05:59.000000000 -0700
@@ -6,7 +6,7 @@
import System
import Time
-import IOExts
+import System.IO.Unsafe
import Auxiliary
import RawCGITypes
diff -urN WashNGo-2.3.1/cgi/Makefile WashNGo-2.3.1-compat-6.4/cgi/Makefile
--- WashNGo-2.3.1/cgi/Makefile 2005-03-13 17:48:52.000000000 -0800
+++ WashNGo-2.3.1-compat-6.4/cgi/Makefile 2005-05-16 23:08:49.000000000 -0700
@@ -74,7 +74,7 @@
$(INSTALL) -c -m 644 libWASHCGI.a $(PACKAGELIBDIR)
$(RANLIB) $(PACKAGELIBDIR)/libWASHCGI.a
ifeq ($(ENABLE_REG_PACKAGE),yes)
- $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries WASHCGI --package_deps haskell98 text WASHHTML WASHMail Utility | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
+ $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries WASHCGI --package_deps haskell98 text WASHHTML WASHMail Utility --exposed_modules $(LIBSOURCES:.hs=) | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
endif
install: install-dumb-package
diff -urN WashNGo-2.3.1/GenPKG/Main.hs WashNGo-2.3.1-compat-6.4/GenPKG/Main.hs
--- WashNGo-2.3.1/GenPKG/Main.hs 2004-08-06 07:30:21.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/GenPKG/Main.hs 2005-05-16 23:06:29.000000000 -0700
@@ -3,6 +3,7 @@
import IO
import Monad
import System
+import Data.List
data FIELDTYPES =
STRING | BOOL Bool | STRING_LIST
@@ -20,7 +21,8 @@
,("extra_ghc_opts", STRING_LIST)
,("extra_ld_opts", STRING_LIST)
,("framework_dirs", STRING_LIST)
- ,("extra_frameworks", STRING_LIST)]
+ ,("extra_frameworks", STRING_LIST)
+ ,("exposed_modules", STRING_LIST)]
main =
do args <- getArgs
@@ -28,9 +30,9 @@
package pkg
package pkg =
- do putStrLn "Package{"
- commaSeparated (putField pkg) fieldDesc
- putStrLn "}"
+ do --putStrLn "Package {"
+ mapM_ (putField pkg) fieldDesc
+ --putStrLn "}"
commaSeparated f [] = return ()
commaSeparated f [x] = f x
@@ -38,13 +40,13 @@
putField pkg (fname, ftype) =
let vals = assocList pkg fname in
- do putStr fname
- putStr " = "
+ do putStr $ if fname == "package_deps" then "depends" else map (\c -> case c of '_' -> '-'; _ -> c) fname
+ putStr ": "
case ftype of
STRING ->
case vals of
[val] ->
- putStr (show val)
+ putStr (val)
_ ->
error ("Field " ++ fname ++ " must be defined exactly once")
BOOL b ->
@@ -57,7 +59,8 @@
((x, ""):_) | x || not x -> putStr val
_ -> error ("Field " ++ fname ++ " must be a Bool")
STRING_LIST ->
- putStr (show vals)
+ putStr ((concat . (intersperse ", ")) vals)
+ putStrLn ""
parseArgs lname desc [] =
[]
diff -urN WashNGo-2.3.1/Mail/Makefile WashNGo-2.3.1-compat-6.4/Mail/Makefile
--- WashNGo-2.3.1/Mail/Makefile 2005-03-13 17:48:52.000000000 -0800
+++ WashNGo-2.3.1-compat-6.4/Mail/Makefile 2005-05-16 23:14:14.000000000 -0700
@@ -53,7 +53,7 @@
$(INSTALL) -c -m 644 libWASHMail.a $(PACKAGELIBDIR)
$(RANLIB) $(PACKAGELIBDIR)/libWASHMail.a
ifeq ($(ENABLE_REG_PACKAGE),yes)
- $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text Utility | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
+ $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text Utility --exposed_modules $(LIBSOURCES:.hs=) | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
endif
######################################################################
diff -urN WashNGo-2.3.1/Utility/ISO8601.hs WashNGo-2.3.1-compat-6.4/Utility/ISO8601.hs
--- WashNGo-2.3.1/Utility/ISO8601.hs 2004-08-06 07:32:42.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/Utility/ISO8601.hs 2005-05-16 21:03:55.000000000 -0700
@@ -5,7 +5,7 @@
import Monad
import Time
-import IOExts
+import System.IO.Unsafe
import IntToString
import SimpleParser
diff -urN WashNGo-2.3.1/Utility/Makefile WashNGo-2.3.1-compat-6.4/Utility/Makefile
--- WashNGo-2.3.1/Utility/Makefile 2005-03-13 17:48:52.000000000 -0800
+++ WashNGo-2.3.1-compat-6.4/Utility/Makefile 2005-05-16 23:14:45.000000000 -0700
@@ -70,7 +70,7 @@
$(INSTALL) -c -m 644 libUtility.a $(PACKAGELIBDIR)
$(RANLIB) $(PACKAGELIBDIR)/libUtility.a
ifeq ($(ENABLE_REG_PACKAGE),yes)
- $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
+ $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text --exposed_modules $(LIBSOURCES:.hs=) | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
endif
######################################################################
diff -urN WashNGo-2.3.1/Utility/SHA1.hs WashNGo-2.3.1-compat-6.4/Utility/SHA1.hs
--- WashNGo-2.3.1/Utility/SHA1.hs 2004-08-06 07:32:42.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/Utility/SHA1.hs 2005-05-16 21:07:28.000000000 -0700
@@ -1,4 +1,6 @@
+{-# LINE 1 "SHA1.hsc" #-}
-- SHA1 hash function.
+{-# LINE 2 "SHA1.hsc" #-}
-- SHA1:
-- http://sea-to-sky.net/~sreid/sha1.c
@@ -10,7 +12,7 @@
import MarshalAlloc
import CString
import CTypes
-import IOExts
+import System.IO.Unsafe
import Storable (pokeByteOff)
import Bits
import Char
diff -urN WashNGo-2.3.1/Utility/SHA1.hsc WashNGo-2.3.1-compat-6.4/Utility/SHA1.hsc
--- WashNGo-2.3.1/Utility/SHA1.hsc 1969-12-31 16:00:00.000000000 -0800
+++ WashNGo-2.3.1-compat-6.4/Utility/SHA1.hsc 2004-08-06 07:32:42.000000000 -0700
@@ -0,0 +1,50 @@
+-- SHA1 hash function.
+
+-- SHA1:
+-- http://sea-to-sky.net/~sreid/sha1.c
+
+module SHA1 where
+
+import Int
+import Ptr
+import MarshalAlloc
+import CString
+import CTypes
+import IOExts
+import Storable (pokeByteOff)
+import Bits
+import Char
+
+type SHA1_CTX = ()
+type SHA1_DIGEST = Ptr CChar
+
+foreign import ccall "sha1lib.h SHA1Init"
+ sha1_init :: Ptr SHA1_CTX -> IO ()
+foreign import ccall "sha1lib.h SHA1Update"
+ sha1_update :: Ptr SHA1_CTX -> Ptr CChar -> Int32 -> IO ()
+foreign import ccall "sha1lib.h SHA1Final"
+ sha1_final :: SHA1_DIGEST -> Ptr SHA1_CTX -> IO ()
+
+sha1 :: String -> String
+sha1 str =
+ unsafePerformIO $
+ do sha1_context <- mallocBytes (64 + 5*4 + 2*4)
+ sha1_digest <- mallocBytes 20
+ sha1_init sha1_context
+ let loop s =
+ -- Process 16KB block in every round.
+ case splitAt 16384 s of
+ (xs, ys) ->
+ do cs <- newCString xs
+ sha1_update sha1_context cs (fromIntegral (length xs))
+ case ys of
+ [] -> return ()
+ _ -> loop ys
+ loop str
+ sha1_final sha1_digest sha1_context
+ peekCStringLen (sha1_digest, 20)
+
+
+
+
+
diff -urN WashNGo-2.3.1/WASH/Makefile WashNGo-2.3.1-compat-6.4/WASH/Makefile
--- WashNGo-2.3.1/WASH/Makefile 2005-03-13 17:48:52.000000000 -0800
+++ WashNGo-2.3.1-compat-6.4/WASH/Makefile 2005-05-16 23:13:56.000000000 -0700
@@ -79,7 +79,7 @@
$(INSTALL) -c -m 644 libWASHHTML.a $(PACKAGELIBDIR)
$(RANLIB) $(PACKAGELIBDIR)/libWASHHTML.a
ifeq ($(ENABLE_REG_PACKAGE),yes)
- $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text Utility | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
+ $(GENPKG) $(PACKAGE) --import_dirs $(PACKAGEIMPORTDIR) --library_dirs $(PACKAGELIBDIR) --hs_libraries $(PACKAGE) --package_deps text Utility --exposed_modules $(LIBSOURCES:.hs=) | $(GHCPKG) $(GHCPKGFLAGS) --update-package --auto-ghci-libs
endif
######################################################################
diff -urN WashNGo-2.3.1/washparser/hs/WASHUtil.hs WashNGo-2.3.1-compat-6.4/washparser/hs/WASHUtil.hs
--- WashNGo-2.3.1/washparser/hs/WASHUtil.hs 2004-08-06 07:38:43.000000000 -0700
+++ WashNGo-2.3.1-compat-6.4/washparser/hs/WASHUtil.hs 2005-05-16 21:02:12.000000000 -0700
@@ -5,7 +5,7 @@
, openFile
) where {
-import IOExts ;
+import System.IO.Unsafe ;
import WASHData ;
itemList :: (item -> ShowS) -> String -> String -> [item] -> ShowS ;
More information about the Libraries
mailing list