X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FPostprocess.hs;h=489a4f9aa89c7c7ae74a7d557ddb28b4eab78d3e;hb=f62b6f07bbf1eefcf552163d8f7daa6e0862ed5d;hp=d3659cc78905f89082d70824b5e0f621ab316fb9;hpb=3d017dd65ddede9a11c5b7a34a91e04340e67bc4;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
index d3659cc..489a4f9 100644
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -56,13 +56,12 @@ import           System.IO.Unsafe
 -}
 
 postprocess :: Interaction -> STM ()
-postprocess itr
-    = itr `seq`
-      do reqM <- readItr itr itrRequest id
+postprocess !itr
+    = do reqM <- readItr itr itrRequest id
          res  <- readItr itr itrResponse id
          let sc = resStatus res
 
-         when (not $ any (\ p -> p sc) [isSuccessful, isRedirection, isError])
+         unless (any (\ p -> p sc) [isSuccessful, isRedirection, isError])
                   $ abortSTM InternalServerError []
                         $ Just ("The status code is not good for a final status: "
                                 ++ show sc)
@@ -119,10 +118,8 @@ postprocess itr
                conn <- readHeader (C8.pack "Connection")
                case conn of
                  Nothing    -> return ()
-                 Just value -> if value `noCaseEq` C8.pack "close" then
-                                   writeItr itr itrWillClose True
-                               else
-                                   return ()
+                 Just value -> when (value `noCaseEq` C8.pack "close")
+                                   $ writeItr itr itrWillClose True
 
                willClose <- readItr itr itrWillClose id
                when willClose
@@ -132,20 +129,17 @@ postprocess itr
                         $ writeTVar (itrWillDiscardBody itr) True
 
       readHeader :: Strict.ByteString -> STM (Maybe Strict.ByteString)
-      readHeader name
-          = name `seq`
-            readItr itr itrResponse $ getHeader name
+      readHeader !name
+          = readItr itr itrResponse $ getHeader name
 
       updateRes :: (Response -> Response) -> STM ()
-      updateRes updator 
-          = updator `seq`
-            updateItr itr itrResponse updator
+      updateRes !updator 
+          = updateItr itr itrResponse updator
 
 
 completeUnconditionalHeaders :: Config -> Response -> IO Response
-completeUnconditionalHeaders conf res
-    = conf `seq` res `seq`
-      return res >>= compServer >>= compDate >>= return
+completeUnconditionalHeaders !conf !res
+    = compServer res >>= compDate
       where
         compServer res'
             = case getHeader (C8.pack "Server") res' of
@@ -177,7 +171,6 @@ getCurrentDate = do now                     <- getCurrentTime
     where
       mostlyEq :: UTCTime -> UTCTime -> Bool
       mostlyEq a b
-          = if utctDay a == utctDay b then
-                fromEnum (utctDayTime a) == fromEnum (utctDayTime b)
-            else
-                False
+          = (utctDay a == utctDay b)
+            &&
+            (fromEnum (utctDayTime a) == fromEnum (utctDayTime b))