1 module Rakka.Resource.Render
6 import Control.Arrow.ArrowIO
7 import Control.Arrow.ArrowList
8 import Control.Monad.Trans
9 import qualified Data.ByteString.Lazy as Lazy
10 import Network.HTTP.Lucu
11 import Rakka.Environment
14 import Rakka.Wiki.Engine
15 import System.FilePath.Posix
16 import Text.XML.HXT.Arrow.Namespace
17 import Text.XML.HXT.Arrow.WriteDocument
18 import Text.XML.HXT.Arrow.XmlArrow
19 import Text.XML.HXT.DOM.TypeDefs
20 import Text.XML.HXT.DOM.XmlKeywords
23 resRender :: Environment -> ResourceDef
26 resUsesNativeThread = False
30 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
35 toPageName :: [String] -> PageName
36 toPageName = UTF8.decodeString . joinPath
41 POST /render/Foo/Bar HTTP/1.0
42 Content-Type: text/x-rakka
49 Content-Type: text/xml
51 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
53 <xhtml:h1>foo</xhtml:h1>
59 handleRender :: Environment -> PageName -> Resource ()
61 = do entity <- inputLBS defaultLimit
62 cTypeM <- getContentType
64 let (bin, cType) = case cTypeM of
65 Just (MIMEType "application" "x-rakka-base64-stream" _)
66 -> let b = decodeBase64LBS entity
72 -> (entity, guessMIMEType entity)
74 setContentType $ read "text/xml"
75 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
77 constA (name, cType, bin)
81 writeDocumentToString [ (a_indent , v_1)
82 , (a_output_encoding, utf8)
83 , (a_no_xml_pi , v_0) ]
88 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
90 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
92 = proc (pName, pType, pBin)
93 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
94 -< (pName, pType, pBin)
97 += ( eelem "renderResult"
101 uniqueNamespacesFromDeclAndQNames