module Text.XML.HXT.Arrow.LibHTTPInput
( getHTTPNativeContents
, withHTTP
, httpOptions
)
where
import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowTree
import Control.Arrow.ArrowIO
import qualified Data.ByteString.Lazy as B
import System.Console.GetOpt
import Text.XML.HXT.Arrow.DocumentInput ( addInputError )
import Text.XML.HXT.IO.GetHTTPNative ( getCont )
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.Arrow.XmlState.TypeDefs
getHTTPNativeContents :: IOSArrow XmlTree XmlTree
getHTTPNativeContents
= getC
$<<
( getAttrValue transferURI
&&&
getSysVar (theInputOptions .&&&.
theProxy .&&&.
theStrictInput .&&&.
theRedirect
)
)
where
getC uri (options, (proxy, (strictInput, redirect)))
= applyA ( ( traceMsg 2 ( "get HTTP via native HTTP interface, uri=" ++ show uri ++ " options=" ++ show options )
>>>
arrIO0 (getCont strictInput proxy uri redirect options)
)
>>>
( arr (uncurry addInputError)
|||
arr addContent
)
)
addContent :: (Attributes, B.ByteString) -> IOSArrow XmlTree XmlTree
addContent (al, bc)
= replaceChildren (blb bc)
>>>
seqA (map (uncurry addAttr) al)
a_use_http :: String
a_use_http = "use-http"
withHTTP :: Attributes -> SysConfig
withHTTP httpOpts = setS theHttpHandler getHTTPNativeContents
>>>
withInputOptions httpOpts
httpOptions :: [OptDescr SysConfig]
httpOptions = [ Option "" [a_use_http] (NoArg (withHTTP [])) "enable HTTP input with native Haskell HTTP package" ]