From: pho Date: Mon, 5 Nov 2007 08:44:11 +0000 (+0900) Subject: Small fixes X-Git-Tag: RELEASE-0_2_1~16 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=5fc2e72c153ade03b16071c66a08a316295bb42a;p=Lucu.git Small fixes darcs-hash:20071105084411-62b54-36f000108c5b8adbcabef87756c73c74c408ec5d.gz --- diff --git a/Lucu.cabal b/Lucu.cabal index 1d07b7f..d527a40 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -60,14 +60,14 @@ Library Network.HTTP.Lucu.RequestReader Network.HTTP.Lucu.ResponseWriter ghc-options: - -fglasgow-exts -Wall + -XDeriveDataTypeable + -XUnboxedTuples -funbox-strict-fields Executable lucu-implant-file Main-Is: ImplantFile.hs ghc-options: - -fglasgow-exts -Wall -funbox-strict-fields diff --git a/Makefile b/Makefile index 7e30a9f..fc09869 100644 --- a/Makefile +++ b/Makefile @@ -1,27 +1,27 @@ CABAL_FILE = Lucu.cabal GHC = ghc -build: .setup-config Setup +build: dist/setup-config Setup ./Setup build run: build @echo ".:.:. Let's go .:.:." $(MAKE) -C examples run -.setup-config: $(CABAL_FILE) Setup +dist/setup-config: $(CABAL_FILE) Setup # ./Setup configure --disable-optimization - ./Setup configure -p --enable-split-objs + ./Setup configure -p -O --enable-split-objs Setup: Setup.hs $(GHC) --make Setup clean: - rm -rf dist Setup Setup.o Setup.hi .setup-config + rm -rf dist Setup Setup.o Setup.hi find . -name '*~' -exec rm -f {} \; $(MAKE) -C examples clean -doc: .setup-config Setup - ./Setup haddock --hyperlink-source --haddock-css=../hscolour/hscolour.css +doc: dist/setup-config Setup + ./Setup haddock --hyperlink-source --hscolour-css=../hscolour/hscolour.css install: build sudo ./Setup install diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index 9632b29..f7f8a1d 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -60,10 +60,10 @@ runHttpd cnf tree fbs loop so -- 本當は Network.accept を使ひたいが、このアクションは勝手に -- リモートのIPを逆引きするので、使へない。 - = do (h, addr) <- accept' so - tQueue <- newInteractionQueue - readerTID <- forkIO $ requestReader cnf tree fbs h addr tQueue - writerTID <- forkIO $ responseWriter cnf h tQueue readerTID + = do (h, addr) <- accept' so + tQueue <- newInteractionQueue + readerTID <- forkIO $ requestReader cnf tree fbs h addr tQueue + _writerTID <- forkIO $ responseWriter cnf h tQueue readerTID loop so accept' :: Socket -> IO (Handle, So.SockAddr) diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs index cef168c..51c30b6 100644 --- a/Network/HTTP/Lucu/Resource/Tree.hs +++ b/Network/HTTP/Lucu/Resource/Tree.hs @@ -240,7 +240,8 @@ runResource def itr ErrorCall msg -> Abortion InternalServerError emptyHeaders $ Just msg IOException ioE -> Abortion InternalServerError emptyHeaders $ Just $ formatIOE ioE DynException dynE -> case fromDynamic dynE of - Just (a :: Abortion) -> a + Just a + -> a :: Abortion Nothing -> Abortion InternalServerError emptyHeaders $ Just $ show exc