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
18 import Rakka.Wiki.Engine
19 import Rakka.Wiki.Parser
20 import Rakka.Wiki.Interpreter
21 import Text.ParserCombinators.Parsec
22 import Text.XML.HXT.Arrow.Namespace
23 import Text.XML.HXT.Arrow.WriteDocument
24 import Text.XML.HXT.Arrow.XmlArrow
25 import Text.XML.HXT.Arrow.XmlIOStateArrow
26 import Text.XML.HXT.DOM.TypeDefs
27 import Text.XML.HXT.DOM.XmlKeywords
30 resRender :: Environment -> ResourceDef
33 resUsesNativeThread = False
37 , resPost = Just $ getPathInfo >>= handleRender env . toPageName
42 toPageName :: [String] -> PageName
43 toPageName = decodePageName . joinWith "/"
48 POST /render/Foo/Bar HTTP/1.0
49 Content-Type: text/x-rakka
56 Content-Type: text/xml
58 <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
60 <xhtml:h1>foo</xhtml:h1>
66 handleRender :: Environment -> PageName -> Resource ()
68 = do cType <- guessTypeIfNeeded =<< getContentType
69 bin <- inputLBS defaultLimit
71 setContentType $ read "text/xml"
72 [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
74 constA (name, cType, bin)
78 writeDocumentToString [ (a_indent, v_1) ]
82 guessTypeIfNeeded :: Maybe MIMEType -> Resource MIMEType
83 guessTypeIfNeeded (Just t) = return t
84 guessTypeIfNeeded Nothing = fail "not impl"
87 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
89 -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
91 = proc (pName, pType, pBin)
92 -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
93 -< (pName, pType, pBin)
96 += ( eelem "renderResult"
100 uniqueNamespacesFromDeclAndQNames