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

diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
index d3659cc..0bd33ed 100644
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -11,13 +11,13 @@ import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
 import           Data.IORef
 import           Data.Maybe
 import           Data.Time
+import qualified Data.Time.HTTP as HTTP
 import           GHC.Conc (unsafeIOToSTM)
 import           Network.HTTP.Lucu.Abortion
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
 import           Network.HTTP.Lucu.Interaction
-import           Network.HTTP.Lucu.RFC1123DateTime
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
 import           System.IO.Unsafe
@@ -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
@@ -171,13 +165,12 @@ getCurrentDate = do now                     <- getCurrentTime
                     if now `mostlyEq` cachedTime then
                         return cachedStr
                       else
-                        do let dateStr = C8.pack $ formatHTTPDateTime now
+                        do let dateStr = C8.pack $ HTTP.format now
                            writeIORef cache (now, dateStr)
                            return dateStr
     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))