--- /dev/null
+module Rakka.Resource.Render
+ ( resRender
+ )
+ where
+
+import Control.Arrow
+import Control.Arrow.ArrowIO
+import Control.Arrow.ArrowList
+import Control.Monad.Trans
+import qualified Codec.Binary.UTF8.String as UTF8
+import qualified Data.ByteString.Lazy as Lazy
+import qualified Data.Map as M
+import Network.HTTP.Lucu
+import Network.HTTP.Lucu.Utils
+import Rakka.Environment
+import Rakka.Page
+import Rakka.Wiki
+import Rakka.Wiki.Engine
+import Rakka.Wiki.Parser
+import Rakka.Wiki.Interpreter
+import Text.ParserCombinators.Parsec
+import Text.XML.HXT.Arrow.Namespace
+import Text.XML.HXT.Arrow.WriteDocument
+import Text.XML.HXT.Arrow.XmlArrow
+import Text.XML.HXT.Arrow.XmlIOStateArrow
+import Text.XML.HXT.DOM.TypeDefs
+import Text.XML.HXT.DOM.XmlKeywords
+
+
+resRender :: Environment -> ResourceDef
+resRender env
+ = ResourceDef {
+ resUsesNativeThread = False
+ , resIsGreedy = True
+ , resGet = Nothing
+ , resHead = Nothing
+ , resPost = Just $ getPathInfo >>= handleRender env . toPageName
+ , resPut = Nothing
+ , resDelete = Nothing
+ }
+ where
+ toPageName :: [String] -> PageName
+ toPageName = decodePageName . joinWith "/"
+
+
+{-
+ --- Request ---
+ POST /render/Foo/Bar HTTP/1.0
+ Content-Type: text/x-rakka
+
+ = foo =
+ blah blah...
+
+ --- Response ---
+ HTTP/1.1 200 OK
+ Content-Type: text/xml
+
+ <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
+ name="Foo/Bar">
+ <xhtml:h1>foo</xhtml:h1>
+ <xhtml:p>
+ blah blah...
+ </xhtml:p>
+ </renderResult>
+-}
+handleRender :: Environment -> PageName -> Resource ()
+handleRender env name
+ = do cType <- guessTypeIfNeeded =<< getContentType
+ bin <- inputLBS defaultLimit
+
+ setContentType $ read "text/xml"
+ [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
+ >>>
+ constA (name, cType, bin)
+ >>>
+ render env
+ >>>
+ writeDocumentToString [ (a_indent, v_1) ]
+ )
+ output xmlStr
+ where
+ guessTypeIfNeeded :: Maybe MIMEType -> Resource MIMEType
+ guessTypeIfNeeded (Just t) = return t
+ guessTypeIfNeeded Nothing = fail "not impl"
+
+
+render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Environment
+ -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
+render env
+ = proc (pName, pType, pBin)
+ -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
+ -< (pName, pType, pBin)
+
+ ( eelem "/"
+ += ( eelem "renderResult"
+ += sattr "name" pName
+ += constL pageBody
+ >>>
+ uniqueNamespacesFromDeclAndQNames
+ ) ) -<< ()
+