1 module Rakka.Resource.Render
7 import Control.Arrow.ArrowIO
8 import Control.Arrow.ArrowList
9 import Control.Monad.Trans
10 import qualified Data.ByteString.Lazy as Lazy
12 import Network.HTTP.Lucu
13 import Network.HTTP.Lucu.Utils
14 import OpenSSL.EVP.Base64
15 import Rakka.Environment
18 import Rakka.Wiki.Engine
19 import Text.XML.HXT.Arrow.Namespace
20 import Text.XML.HXT.Arrow.WriteDocument
21 import Text.XML.HXT.Arrow.XmlArrow
22 import Text.XML.HXT.Arrow.XmlIOStateArrow
23 import Text.XML.HXT.DOM.TypeDefs
24 import Text.XML.HXT.DOM.XmlKeywords
27 resRender :: Environment -> ResourceDef
30 resUsesNativeThread = False
34 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
39 toPageName :: [String] -> PageName
40 toPageName = decodePageName . joinWith "/"
45 POST /render/Foo/Bar HTTP/1.0
46 Content-Type: text/x-rakka
53 Content-Type: text/xml
55 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
57 <xhtml:h1>foo</xhtml:h1>
63 handleRender :: Environment -> PageName -> Resource ()
65 = do entity <- inputLBS defaultLimit
66 cTypeM <- getContentType
68 let (bin, cType) = case cTypeM of
69 Just (MIMEType "application" "x-rakka-base64-stream" _)
70 -> let b = decodeBase64LBS entity
76 -> (entity, guessMIMEType entity)
78 setContentType $ read "text/xml"
79 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
81 constA (name, cType, bin)
85 writeDocumentToString [ (a_indent, v_1) ]
90 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
92 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
94 = proc (pName, pType, pBin)
95 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
96 -< (pName, pType, pBin)
99 += ( eelem "renderResult"
100 += sattr "name" pName
103 uniqueNamespacesFromDeclAndQNames