]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/DefaultPage.hs
ResponseWriter now compiles.
[Lucu.git] / Network / HTTP / Lucu / DefaultPage.hs
index c315424414857aba8b5ffe0d1047dac10c0db5bb..1e5a7a6c6e51ebc422d72db62d024f56ac93df0a 100644 (file)
@@ -10,7 +10,7 @@ module Network.HTTP.Lucu.DefaultPage
     , mkDefaultPage
     )
     where
-import qualified Blaze.ByteString.Builder.ByteString as BB
+import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
 import Control.Arrow
 import Control.Arrow.ArrowList
 import Control.Arrow.ListArrow
@@ -21,7 +21,6 @@ import qualified Data.Ascii as A
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as Lazy
-import qualified Data.Text.Lazy.Encoding as Lazy
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Interaction
@@ -48,15 +47,14 @@ getDefaultPage !conf !req !res
 writeDefaultPage ∷ Interaction → STM ()
 writeDefaultPage !itr
     -- Content-Type が正しくなければ補完できない。
-    = do res ← readItr itrResponse id itr
+    = do res ← readItr itrResponse itr
          when (getHeader "Content-Type" res == Just defaultPageContentType)
-                  $ do reqM ← readItr itrRequest id itr
+                  $ do reqM ← readItr itrRequest itr
 
                        let conf = itrConfig itr
                            page = getDefaultPage conf reqM res
 
-                       putTMVar (itrBodyToSend itr)
-                                (BB.fromLazyByteString $ Lazy.encodeUtf8 page)
+                       putTMVar (itrBodyToSend itr) (BB.fromLazyText page)
 
 mkDefaultPage ∷ (ArrowXml a) ⇒ Config → StatusCode → a b XmlTree → a b XmlTree
 {-# INLINEABLE mkDefaultPage #-}