X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FDefaultPage.hs;h=f53501f707f1b36d2dec25f021607a42e694e9cf;hb=15aa04a569fb13fb0793389f78f52b0255083cef;hp=a79e47b49c9f143d6d83638868d42be26cd0d901;hpb=858129cb755aa09da2b7bd758efb8519f2c89103;p=Lucu.git

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index a79e47b..f53501f 100644
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -1,4 +1,3 @@
--- #hide, prune
 module Network.HTTP.Lucu.DefaultPage
     ( getDefaultPage
     , writeDefaultPage
@@ -10,8 +9,8 @@ import           Control.Arrow
 import           Control.Arrow.ArrowList
 import           Control.Concurrent.STM
 import           Control.Monad
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy.Char8 as L8
 import           Data.Maybe
 import           Network
 import           Network.HTTP.Lucu.Config
@@ -49,11 +48,11 @@ writeDefaultPage itr
 
          -- Content-Type が正しくなければ補完できない。
          res <- readItr itr itrResponse id
-         when (getHeader "Content-Type" res == Just defaultPageContentType)
+         when (getHeader (C8.pack "Content-Type") res == Just defaultPageContentType)
                   $ do reqM <- readItr itr itrRequest id
 
                        let conf = itrConfig itr
-                           page = B.pack $ getDefaultPage conf reqM res
+                           page = L8.pack $ getDefaultPage conf reqM res
 
                        writeTVar (itrBodyToSend itr)
                                      $ page
@@ -62,15 +61,15 @@ writeDefaultPage itr
 mkDefaultPage :: (ArrowXml a) => Config -> StatusCode -> a b XmlTree -> a b XmlTree
 mkDefaultPage conf status msgA
     = conf `seq` status `seq` msgA `seq`
-      let (sCode, sMsg) = statusCode status
-          sig           = cnfServerSoftware conf
-                          ++ " at "
-                          ++ cnfServerHost conf
-                          ++ ( case cnfServerPort conf of
-                                 Service    serv -> ", service " ++ serv
-                                 PortNumber num  -> ", port " ++ show num
-                                 UnixSocket path -> ", unix socket " ++ show path
-                             )
+      let (# sCode, sMsg #) = statusCode status
+          sig               = C8.unpack (cnfServerSoftware conf)
+                              ++ " at "
+                              ++ C8.unpack (cnfServerHost conf)
+                              ++ ( case cnfServerPort conf of
+                                     Service    serv -> ", service " ++ serv
+                                     PortNumber num  -> ", port " ++ show num
+                                     UnixSocket path -> ", unix socket " ++ show path
+                                 )
       in ( eelem "/"
            += ( eelem "html"
                 += sattr "xmlns" "http://www.w3.org/1999/xhtml"
@@ -166,6 +165,6 @@ getMsg req res
                uriPath uri
 
       loc :: String
-      loc = fromJust $! getHeader "Location" res
+      loc = C8.unpack $! fromJust $! getHeader (C8.pack "Location") res
 
 {-# SPECIALIZE getMsg :: Maybe Request -> Response -> IOSArrow b XmlTree #-}
\ No newline at end of file