1 module Rakka.Resource.Render
7 import Control.Arrow.ArrowIO
8 import Control.Arrow.ArrowList
9 import Control.Monad.Trans
10 import qualified Codec.Binary.UTF8.String as UTF8
11 import qualified Data.ByteString.Lazy as Lazy
12 import qualified Data.Map as M
13 import Network.HTTP.Lucu
14 import Network.HTTP.Lucu.Utils
15 import Rakka.Environment
19 import Rakka.Wiki.Engine
20 import Rakka.Wiki.Parser
21 import Rakka.Wiki.Interpreter
22 import Text.ParserCombinators.Parsec
23 import Text.XML.HXT.Arrow.Namespace
24 import Text.XML.HXT.Arrow.WriteDocument
25 import Text.XML.HXT.Arrow.XmlArrow
26 import Text.XML.HXT.Arrow.XmlIOStateArrow
27 import Text.XML.HXT.DOM.TypeDefs
28 import Text.XML.HXT.DOM.XmlKeywords
31 resRender :: Environment -> ResourceDef
34 resUsesNativeThread = False
38 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
43 toPageName :: [String] -> PageName
44 toPageName = decodePageName . joinWith "/"
49 POST /render/Foo/Bar HTTP/1.0
50 Content-Type: text/x-rakka
57 Content-Type: text/xml
59 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
61 <xhtml:h1>foo</xhtml:h1>
67 handleRender :: Environment -> PageName -> Resource ()
69 = do bin <- inputLBS defaultLimit
70 cTypeM <- getContentType
72 let cType = case cTypeM of
74 Nothing -> guessMIMEType bin
76 setContentType $ read "text/xml"
77 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
79 constA (name, cType, bin)
83 writeDocumentToString [ (a_indent, v_1) ]
88 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
90 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
92 = proc (pName, pType, pBin)
93 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
94 -< (pName, pType, pBin)
97 += ( eelem "renderResult"
101 uniqueNamespacesFromDeclAndQNames