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)
14 import Network.HTTP.Lucu
15 import Network.HTTP.Lucu.Utils
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 = Lazy.pack $ fromJust $ B64.decode $ L8.unpack 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) ]
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