Fixed build failure on recent GHC and other libraries

Ignore-this: 501bbd7f30b7537184ef08893e525f10

darcs-hash:20110727072305-62b54-8dc2711ce92213f2efa5e2741c42f88f0cbcaaa1.gz

diff --git a/GNUmakefile b/GNUmakefile
index e85c5ed982cf32d15f962bc882a7480fc285d73e..8b9ab3191225d324578dd39e119dc07643ba476e 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -2,4 +2,16 @@ RUN_COMMAND = $(MAKE) -C examples run
 
 CONFIGURE_ARGS = -O
 
-include cabal-package.mk
\ No newline at end of file
+include cabal-package.mk
+
+update-web: update-web-doc update-web-ditz
+
+update-web-doc: doc
+       rsync -av --delete \
+               dist/doc/html/Lucu/ \
+               www@nem.cielonegro.org:static.cielonegro.org/htdocs/doc/Lucu
+
+update-web-ditz: ditz
+       rsync -av --delete \
+               dist/ditz/ \
+               www@nem.cielonegro.org:static.cielonegro.org/htdocs/ditz/Lucu

diff --git a/Lucu.cabal b/Lucu.cabal
index ddb7e3c1adbe2a57075224ee17c5f64975b44668..dc377571815a952e8fbf5e44684bd8e970fb030c 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -16,7 +16,7 @@ Maintainer: PHO <pho at cielonegro dot org>
 Stability: experimental
 Homepage: http://cielonegro.org/Lucu.html
 Category: Network
-Tested-With: GHC == 6.12.1
+Tested-With: GHC == 7.0.3
 Cabal-Version: >= 1.6
 Build-Type: Simple
 Extra-Source-Files:
@@ -43,19 +43,19 @@ Flag build-lucu-implant-file
 
 Library
     Build-Depends:
-        HsOpenSSL   == 0.8.*,
-        base        == 4.2.*,
+        HsOpenSSL   == 0.10.*,
+        base        == 4.3.*,
         bytestring  == 0.9.*,
-        containers  == 0.3.*,
-        dataenc     == 0.13.*,
-        filepath    == 1.1.*,
-        directory   == 1.0.*,
+        containers  == 0.4.*,
+        dataenc     == 0.14.*,
+        filepath    == 1.2.*,
+        directory   == 1.1.*,
         haskell-src == 1.0.*,
-        hxt         == 8.5.*,
-        mtl         == 1.1.*,
-        network     == 2.2.*,
-        stm         == 2.1.*,
-        time        == 1.1.*,
+        hxt         == 9.1.*,
+        mtl         == 2.0.*,
+        network     == 2.3.*,
+        stm         == 2.2.*,
+        time        == 1.2.*,
         time-http   == 0.1.*,
         unix        == 2.4.*,
         zlib        == 0.5.*

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 6d36ea8e89ec1b822b30004fecf466c1669baf7b..db0c55262c62d9a568cf22347ace59c1f60f7e5b 100644 (file)
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -28,8 +28,7 @@ import           Network.HTTP.Lucu.Response
 import           System.IO.Unsafe
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlArrow
-import           Text.XML.HXT.Arrow.XmlIOStateArrow
-import           Text.XML.HXT.DOM.XmlKeywords
+import           Text.XML.HXT.Arrow.XmlState
 
 
 data Abortion = Abortion {
@@ -102,7 +101,7 @@ abortPage conf reqM res abo
             -> let [html] = unsafePerformIO 
                             $ runX ( mkDefaultPage conf (aboStatus abo) (txt msg)
                                      >>>
-                                     writeDocumentToString [(a_indent, v_1)]
+                                     writeDocumentToString [ withIndent True ]
                                    )
                in
                  html

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index 2220c7fca408d5b416ec324103dbe0ed646b4e02..5fd170564ef0dd5cb2ff1282bef839a1a71b5964 100644 (file)
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -22,9 +22,8 @@ import           Network.URI hiding (path)
 import           System.IO.Unsafe
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlArrow
-import           Text.XML.HXT.Arrow.XmlIOStateArrow
+import           Text.XML.HXT.Arrow.XmlState
 import           Text.XML.HXT.DOM.TypeDefs
-import           Text.XML.HXT.DOM.XmlKeywords
 
 
 getDefaultPage :: Config -> Maybe Request -> Response -> String
@@ -34,7 +33,7 @@ getDefaultPage !conf !req !res
         unsafePerformIO $
         do [xmlStr] <- runX ( mkDefaultPage conf (resStatus res) msgA
                               >>>
-                              writeDocumentToString [ (a_indent, v_1) ]
+                              writeDocumentToString [ withIndent True ]
                             )
            return xmlStr
 

diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs
index d08a145f5bc47b1de9fbde9d3e1944000d75c617..34953f58c9dc5de637759c671f672b02815aa59e 100644 (file)
--- a/Network/HTTP/Lucu/Parser.hs
+++ b/Network/HTTP/Lucu/Parser.hs
@@ -52,7 +52,7 @@ module Network.HTTP.Lucu.Parser
     )
     where
 
-import           Control.Monad.State.Strict
+import           Control.Monad.State.Strict hiding (state)
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as B hiding (ByteString)
 import qualified Data.Foldable as Fold

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index fc3fcbdfcde6cd01ce13cf36d3df3b44ddd9a45c..9f9fa0d68c3b83f187c6316213cc100f39cdc5cf 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE
+    BangPatterns
+  #-}
 module Network.HTTP.Lucu.Preprocess
     ( preprocess
     )
@@ -47,9 +50,8 @@ import           Network.URI
 -}
 
 preprocess :: Interaction -> STM ()
-preprocess itr
-    = itr `seq`
-      do req <- readItr itr itrRequest fromJust
+preprocess !itr
+    = do req <- readItr itr itrRequest fromJust
 
          let reqVer = reqVersion req
 
@@ -109,9 +111,8 @@ preprocess itr
 
 
       updateAuthority :: Strict.ByteString -> Strict.ByteString -> STM ()
-      updateAuthority host portStr
-          = host `seq` portStr `seq`
-            updateItr itr itrRequest
+      updateAuthority !host !portStr
+          = updateItr itr itrRequest
             $! \ (Just req) -> Just req {
                                  reqURI = let uri = reqURI req
                                           in uri {
@@ -125,9 +126,8 @@ preprocess itr
                 
 
       preprocessHeader :: Request -> STM ()
-      preprocessHeader req
-          = req `seq`
-            do case getHeader (C8.pack "Expect") req of
+      preprocessHeader !req
+          = do case getHeader (C8.pack "Expect") req of
                  Nothing    -> return ()
                  Just value -> if value `noCaseEq` C8.pack "100-continue" then
                                    writeItr itr itrExpectedContinue True

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 34c1a725634b6485df32d7e5e302238e44cf78b4..15b211fba6d17872dc6201a55d8a69bdfd42c326 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -413,7 +413,7 @@ getAuthorization
 -- |Tell the system that the 'Resource' found an entity for the
 -- request URI. If this is a GET or HEAD request, a found entity means
 -- a datum to be replied. If this is a PUT or DELETE request, it means
--- a datum which was stored for the URI up to now. It is an error to
+-- a datum which was stored for the URI until now. It is an error to
 -- compute 'foundEntity' if this is a POST request.
 --
 -- Computation of 'foundEntity' performs \"If-Match\" test or
@@ -434,7 +434,7 @@ foundEntity tag timeStamp
                   $ setHeader' (C8.pack "Last-Modified") (C8.pack $ HTTP.format timeStamp)
          when (method == POST)
                   $ abort InternalServerError []
-                        (Just "Illegal computation of foundEntity for POST request.")
+                        (Just "Illegal computation of foundEntity for a POST request.")
          foundETag tag
 
          driftTo GettingBody

diff --git a/cabal-package.mk b/cabal-package.mk
index d8bbaad16ee155ad694cb2b90652a37fdb10636e..585fc30b5684cf9a145d8f4786e44184551f7605 100644 (file)
--- a/cabal-package.mk
+++ b/cabal-package.mk
@@ -14,6 +14,8 @@ RM_RF    ?= rm -rf
 SUDO     ?= sudo
 AUTOCONF ?= autoconf
 HLINT    ?= hlint
+HPC      ?= hpc
+DITZ     ?= ditz
 
 CONFIGURE_ARGS ?= --disable-optimization
 
@@ -40,6 +42,7 @@ all: build
 
 build: setup-config build-hook
        ./Setup build
+       $(RM_RF) *.tix
 
 build-hook:
 
@@ -70,7 +73,7 @@ Setup: $(SETUP_FILE)
        $(GHC) --make Setup
 
 clean: clean-hook
-       $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo
+       $(RM_RF) dist Setup *.o *.hi .setup-config *.buildinfo *.tix .hpc
        $(FIND) . -name '*~' -exec rm -f {} \;
 
 clean-hook:
@@ -85,11 +88,30 @@ sdist: setup-config
        ./Setup sdist
 
 test: build
+       $(RM_RF) dist/test
        ./Setup test
+       if ls *.tix >/dev/null 2>&1; then \
+               $(HPC) sum --output="merged.tix" --union --exclude=Main *.tix; \
+               $(HPC) markup --destdir="dist/hpc" --fun-entry-count "merged.tix"; \
+       fi
+
+ditz:
+       $(DITZ) html dist/ditz
+
+fixme:
+       @$(FIND) . \
+               \( -name 'dist' -or -name '.git' -or -name '_darcs' \) -prune \
+               -or \
+               \( -name '*.c'   -or -name '*.h'   -or \
+                  -name '*.hs'  -or -name '*.lhs' -or \
+                  -name '*.hsc' -or -name '*.cabal' \) \
+               -exec egrep -i '(fixme|thinkme)' {} \+ \
+               || echo 'No FIXME or THINKME found.'
 
 lint:
-       $(HLINT) . --report \
-               --ignore="Use string literal" \
-               --ignore="Use concatMap"
+       $(HLINT) . --report
+#      $(HLINT) . --report \
+#              --ignore="Use string literal" \
+#              --ignore="Use concatMap"
 
 .PHONY: build build-hook setup-config setup-config-hook run clean clean-hook install doc sdist test lint