From 8bdd1da1ee1f3e453dbe2bce246618e12e26d30c Mon Sep 17 00:00:00 2001 From: pho Date: Wed, 27 Jul 2011 16:23:05 +0900 Subject: [PATCH] Fixed build failure on recent GHC and other libraries Ignore-this: 501bbd7f30b7537184ef08893e525f10 darcs-hash:20110727072305-62b54-8dc2711ce92213f2efa5e2741c42f88f0cbcaaa1.gz --- GNUmakefile | 14 +++++++++++++- Lucu.cabal | 24 ++++++++++++------------ Network/HTTP/Lucu/Abortion.hs | 5 ++--- Network/HTTP/Lucu/DefaultPage.hs | 5 ++--- Network/HTTP/Lucu/Parser.hs | 2 +- Network/HTTP/Lucu/Preprocess.hs | 18 +++++++++--------- Network/HTTP/Lucu/Resource.hs | 4 ++-- cabal-package.mk | 30 ++++++++++++++++++++++++++---- 8 files changed, 67 insertions(+), 35 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index e85c5ed..8b9ab31 100644 --- 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 ddb7e3c..dc37757 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -16,7 +16,7 @@ Maintainer: PHO 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 6d36ea8..db0c552 100644 --- 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 2220c7f..5fd1705 100644 --- 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 d08a145..34953f5 100644 --- 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 fc3fcbd..9f9fa0d 100644 --- 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 34c1a72..15b211f 100644 --- 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 d8bbaad..585fc30 100644 --- 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 -- 2.40.0