1 module Rakka.Resource.Render
6 import qualified Codec.Binary.Base64 as B64
8 import Control.Arrow.ArrowIO
9 import Control.Arrow.ArrowList
10 import Control.Monad.Trans
11 import qualified Data.ByteString.Lazy as Lazy (ByteString, pack)
12 import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
13 import Network.HTTP.Lucu
14 import Network.HTTP.Lucu.Utils
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 = Lazy.pack $ B64.decode $ L8.unpack 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