Fix HTTP response

diff --git a/Blog/Blog.hs b/Blog/Blog.hs
index 728d8a6..dd148db 100644
--- a/Blog/Blog.hs
+++ b/Blog/Blog.hs
@@ -96,7 +96,7 @@ editpost conf sid = Just $
                           in do queryListSQL conf (updateM postModel ("id":==:sid)) [ptitle, pbody]
                                 commit conf
                                 invalidatePostsCache conf
-                                return $ redirectG "/blog/" ["code" =: "3"]
+                                return $ redirectG "/blog/" ["code" := "3"]
             Left e -> do cont <- returnInvalidForm conf postForm "1" e
                          return cont
     where url = myUrl (request conf)
@@ -124,7 +124,7 @@ onepost conf sid = Just $ do
                      let cBody   = comment -:> "body"
                      queryListSQL conf (insertM commentModel) [SqlInt32 pid, cAuthor, cBody]
                      commit conf
-                     return $ redirectG url ["code" =: "2"]
+                     return $ redirectG url ["code" := "2"]
               Left e -> returnInvalidForm conf commentForm "1" e
     where url = myUrl (request conf)
           pid = read sid
diff --git a/Framework/Http/Httpd.hs b/Framework/Http/Httpd.hs
index ddb627f..9d8a377 100644
--- a/Framework/Http/Httpd.hs
+++ b/Framework/Http/Httpd.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards,ViewPatterns #-}
+{-# LANGUAGE PatternGuards,ViewPatterns, TypeSynonymInstances #-}
 -- |
 -- Module: Httpd
 -- Copyright: Andy Gill, Ilya Portnov
@@ -50,6 +50,11 @@ import Numeric (showHex)
 type Server = () -- later, you might have a handle for shutting down a server.
 type S = String

+showRC (a,b,c) = x:y:z:[]
+    where x = Char.intToDigit a
+          y = Char.intToDigit b
+          z = Char.intToDigit c
+
 {- |
 This server transfers documents as one parcel, using the content-length header.
 -}
@@ -135,7 +140,7 @@ initServerMain processBody portNo callOut = do
              else work ""
           where work = sendRequest h mode uri hds

-        message code = show code ++ " " ++
+        message code = showRC code ++ " " ++
                        case lookup code longMessages of
                          Just msg -> msg
                          Nothing -> "-"
@@ -145,6 +150,7 @@ initServerMain processBody portNo callOut = do
                                       , rqHeaders = hds
                                       , rqBody   = rbody
                                       }
+--             print resp
             let (additionalHeaders, body) =
                   processBody $ rspBody resp
             writeLines h $
@@ -170,8 +176,8 @@ readUntilEmptyLine h = read' []
 int2respCode :: Int -> ResponseCode
 int2respCode n =
     let c = n `mod` 10
-        b = (n-c) `mod` 100
-        a = (n-10*b-c) `mod` 1000
+        b = ((n-c) `mod` 100) `quot` 10
+        a = ((n-10*b-c) `mod` 1000) `quot` 100
     in (a,b,c)

 -- | Read the given number of bytes from a Handle
@@ -179,8 +185,9 @@ hGetChars :: Handle -> Int -> IO String
 hGetChars h n = fmap L.unpack $ L.hGet h n

 writeLines :: Handle -> [String] -> IO ()
-writeLines h =
-  hPutStr h . concatMap (++"\r\n")
+writeLines h text = do
+--   print text
+  (hPutStr h . concatMap (++"\r\n")) text

 -- | Takes an escaped query, optionally starting with '?', and returns an unescaped index-value list.
 queryToArguments :: String -> [(String,String)]