where
import Control.Arrow
import Control.Arrow.ArrowList
+import Control.Arrow.ListArrow
import Control.Arrow.Unicode
import Control.Concurrent.STM
import Control.Monad
import qualified Data.ByteString.Char8 as C8
import Data.Maybe
import qualified Data.Sequence as S
+import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import Network.URI hiding (path)
-import System.IO.Unsafe
import Prelude.Unicode
import Text.XML.HXT.Arrow.WriteDocument
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.DOM.TypeDefs
-getDefaultPage ∷ Config → Maybe Request → Response → String
+getDefaultPage ∷ Config → Maybe Request → Response → Text
+{-# INLINEABLE getDefaultPage #-}
getDefaultPage !conf !req !res
- = let msgA = getMsg req res
- in
- unsafePerformIO $
- do [xmlStr] ← runX ( mkDefaultPage conf (resStatus res) msgA
+ = let msgA = getMsg req res
+ [xmlStr] = runLA ( mkDefaultPage conf (resStatus res) msgA
⋙
writeDocumentToString [ withIndent True ]
- )
- return xmlStr
+ ) ()
+ in
+ T.pack xmlStr
writeDefaultPage ∷ Interaction → STM ()
writeDefaultPage !itr
$ do reqM ← readItr itr itrRequest id
let conf = itrConfig itr
- page = T.pack $ getDefaultPage conf reqM res
+ page = getDefaultPage conf reqM res
writeTVar (itrBodyToSend itr)
(S.singleton (encodeUtf8 page))