Small fixes

darcs-hash:20071105084411-62b54-36f000108c5b8adbcabef87756c73c74c408ec5d.gz

diff --git a/Lucu.cabal b/Lucu.cabal
index 1d07b7f9726df5bcf6cf36dae5fb203eecbd8b49..d527a40ba6acffff8d25120cc749b34728ffe1f1 100644 (file)
--- 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 7e30a9f4af13c665f7af614e255510c8922d057d..fc098691ff4d4a8ec122238ec9aa74202decb1ee 100644 (file)
--- 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 9632b298193e30a24b4711519896be32b3fa72dd..f7f8a1d8d4c4ddcb5ede9e817cdfc2d2396e41f6 100644 (file)
--- 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 cef168cb522322e80bdbb164a68f3e2db678f3a5..51c30b6908ac67e02bf178d02640f25b6489ad81 100644 (file)
--- 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