X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource.hs;h=c589cecceb1cea38f9ada43cc13b73b6eb7d4ebd;hb=f19a294d54f38faaeab0027ecb5d85388243b924;hp=9f3af22fd6ef2752c0acdece23c4926177427bbc;hpb=ed0a2de09fc91fbd25c3ee82a722ef88793f2a8f;p=Rakka.git diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs index 9f3af22..c589cec 100644 --- a/Rakka/Resource.hs +++ b/Rakka/Resource.hs @@ -1,9 +1,11 @@ module Rakka.Resource ( runIdempotentA + , runIdempotentA' , runXmlA , getEntityType , outputXmlPage , outputXmlPage' + , outputXml , getUserID ) where @@ -68,6 +70,17 @@ runIdempotentA baseURI a rsrc +runIdempotentA' :: IOSArrow () (Resource c) -> Resource c +runIdempotentA' a + = do [rsrc] <- liftIO $ runX ( setErrorMsgHandler False fail + >>> + constA () + >>> + a + ) + rsrc + + runXmlA :: Environment -> FilePath -> IOSArrow XmlTree (Resource c) -> Resource c runXmlA env schemaPath a = do inputA <- getInputXmlA env schemaPath @@ -149,7 +162,9 @@ outputXmlPage tree formatters >>> formatter >>> - writeDocumentToString [ (a_indent, v_1) ] + writeDocumentToString [ (a_indent , v_1 ) + , (a_output_encoding, utf8) + , (a_no_xml_pi , v_0 ) ] ) output resultStr @@ -159,6 +174,20 @@ outputXmlPage' tree toXHTML = outputXmlPage tree [(MIMEType "application" "xhtml+xml" [], toXHTML)] +outputXml :: XmlTree -> Resource () +outputXml tree + = do setContentType (MIMEType "text" "xml" []) + [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail + >>> + constA tree + >>> + writeDocumentToString [ (a_indent , v_1 ) + , (a_output_encoding, utf8) + , (a_no_xml_pi , v_0 ) ] + ) + output xmlStr + + getUserID :: Environment -> Resource (Maybe String) getUserID env = do auth <- getAuthorization