1 module Rakka.Resource.Render
6 import qualified Codec.Binary.UTF8.String as UTF8
8 import Control.Arrow.ArrowIO
9 import Control.Arrow.ArrowList
10 import Control.Monad.Trans
11 import qualified Data.ByteString.Lazy as Lazy
13 import Network.HTTP.Lucu
14 import Network.HTTP.Lucu.Utils
15 import OpenSSL.EVP.Base64
16 import Rakka.Environment
19 import Rakka.Wiki.Engine
20 import Text.XML.HXT.Arrow.Namespace
21 import Text.XML.HXT.Arrow.WriteDocument
22 import Text.XML.HXT.Arrow.XmlArrow
23 import Text.XML.HXT.Arrow.XmlIOStateArrow
24 import Text.XML.HXT.DOM.TypeDefs
25 import Text.XML.HXT.DOM.XmlKeywords
28 resRender :: Environment -> ResourceDef
31 resUsesNativeThread = False
35 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
40 toPageName :: [String] -> PageName
41 toPageName = decodePageName . joinWith "/"
46 POST /render/Foo/Bar HTTP/1.0
47 Content-Type: text/x-rakka
54 Content-Type: text/xml
56 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
58 <xhtml:h1>foo</xhtml:h1>
64 handleRender :: Environment -> PageName -> Resource ()
66 = do entity <- inputLBS defaultLimit
67 cTypeM <- getContentType
69 let (bin, cType) = case cTypeM of
70 Just (MIMEType "application" "x-rakka-base64-stream" _)
71 -> let b = decodeBase64LBS entity
77 -> (entity, guessMIMEType entity)
79 setContentType $ read "text/xml"
80 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
82 constA (name, cType, bin)
86 writeDocumentToString [ (a_indent, v_1) ]
88 output $ UTF8.encodeString xmlStr
91 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
93 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
95 = proc (pName, pType, pBin)
96 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
97 -< (pName, pType, pBin)
100 += ( eelem "renderResult"
101 += sattr "name" pName
104 uniqueNamespacesFromDeclAndQNames