#-}
module Network.HTTP.Lucu.DefaultPage
( getDefaultPage
- , writeDefaultPage
+ , defaultPageContentType
, mkDefaultPage
)
where
-import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ListArrow
import Control.Arrow.Unicode
-import Control.Concurrent.STM
-import Control.Monad
+import Data.Ascii (Ascii)
import qualified Data.Ascii as A
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Lazy as Lazy
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Headers
-import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import Network.URI hiding (path)
in
Lazy.pack xmlStr
-writeDefaultPage ∷ Interaction → STM ()
-writeDefaultPage (Interaction {..})
- -- Content-Type が正しくなければ補完できない。
- = do res ← readTVar itrResponse
- when (getHeader "Content-Type" res ≡ Just defaultPageContentType)
- $ do let page = getDefaultPage itrConfig itrRequest res
- putTMVar itrBodyToSend (BB.fromLazyText page)
+defaultPageContentType ∷ Ascii
+{-# INLINE defaultPageContentType #-}
+defaultPageContentType = "application/xhtml+xml"
mkDefaultPage ∷ (ArrowXml a) ⇒ Config → StatusCode → a b XmlTree → a b XmlTree
{-# INLINEABLE mkDefaultPage #-}