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
12 import Network.HTTP.Lucu
13 import OpenSSL.EVP.Base64
14 import Rakka.Environment
17 import Rakka.Wiki.Engine
18 import System.FilePath.Posix
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 = UTF8.decodeString . joinPath
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)
86 , (a_output_encoding, utf8)
87 , (a_no_xml_pi , v_0) ]
92 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
94 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
96 = proc (pName, pType, pBin)
97 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
98 -< (pName, pType, pBin)
101 += ( eelem "renderResult"
102 += sattr "name" pName
105 uniqueNamespacesFromDeclAndQNames