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