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 OpenSSL.EVP.Base64
12 import Rakka.Environment
15 import Rakka.Wiki.Engine
16 import System.FilePath.Posix
17 import Text.XML.HXT.Arrow.Namespace
18 import Text.XML.HXT.Arrow.WriteDocument
19 import Text.XML.HXT.Arrow.XmlArrow
20 import Text.XML.HXT.DOM.TypeDefs
21 import Text.XML.HXT.DOM.XmlKeywords
24 resRender :: Environment -> ResourceDef
27 resUsesNativeThread = False
31 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
36 toPageName :: [String] -> PageName
37 toPageName = UTF8.decodeString . joinPath
42 POST /render/Foo/Bar HTTP/1.0
43 Content-Type: text/x-rakka
50 Content-Type: text/xml
52 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
54 <xhtml:h1>foo</xhtml:h1>
60 handleRender :: Environment -> PageName -> Resource ()
62 = do entity <- inputLBS defaultLimit
63 cTypeM <- getContentType
65 let (bin, cType) = case cTypeM of
66 Just (MIMEType "application" "x-rakka-base64-stream" _)
67 -> let b = decodeBase64LBS entity
73 -> (entity, guessMIMEType entity)
75 setContentType $ read "text/xml"
76 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
78 constA (name, cType, bin)
82 writeDocumentToString [ (a_indent , v_1)
83 , (a_output_encoding, utf8)
84 , (a_no_xml_pi , v_0) ]
89 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
91 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
93 = proc (pName, pType, pBin)
94 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
95 -< (pName, pType, pBin)
98 += ( eelem "renderResult"
102 uniqueNamespacesFromDeclAndQNames