module Text.XML.HXT.Arrow.LibHTTPInput
( getHTTPNativeContents
, withHTTP
, httpOptions
)
where
import Control.Arrow
import Control.Arrow.ArrowIO
import Control.Arrow.ArrowList
import Control.Arrow.ArrowTree
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 :: IOSArrow XmlTree XmlTree
getHTTPNativeContents
= [Char]
-> ([([Char], [Char])], ([Char], (Bool, Bool)))
-> IOSArrow XmlTree XmlTree
getC
([Char]
-> ([([Char], [Char])], ([Char], (Bool, Bool)))
-> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
XmlTree
([Char], ([([Char], [Char])], ([Char], (Bool, Bool))))
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
( [Char] -> IOSLA (XIOState ()) XmlTree [Char]
forall (a :: * -> * -> *). ArrowXml a => [Char] -> a XmlTree [Char]
getAttrValue [Char]
transferURI
IOSLA (XIOState ()) XmlTree [Char]
-> IOSLA
(XIOState ()) XmlTree ([([Char], [Char])], ([Char], (Bool, Bool)))
-> IOSLA
(XIOState ())
XmlTree
([Char], ([([Char], [Char])], ([Char], (Bool, Bool))))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
Selector XIOSysState ([([Char], [Char])], ([Char], (Bool, Bool)))
-> IOSLA
(XIOState ()) XmlTree ([([Char], [Char])], ([Char], (Bool, Bool)))
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar (Selector XIOSysState [([Char], [Char])]
theInputOptions Selector XIOSysState [([Char], [Char])]
-> Selector XIOSysState ([Char], (Bool, Bool))
-> Selector
XIOSysState ([([Char], [Char])], ([Char], (Bool, Bool)))
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState [Char]
theProxy Selector XIOSysState [Char]
-> Selector XIOSysState (Bool, Bool)
-> Selector XIOSysState ([Char], (Bool, Bool))
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState Bool
theStrictInput Selector XIOSysState Bool
-> Selector XIOSysState Bool -> Selector XIOSysState (Bool, Bool)
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState Bool
theRedirect
)
)
where
getC :: [Char]
-> ([([Char], [Char])], ([Char], (Bool, Bool)))
-> IOSArrow XmlTree XmlTree
getC uri :: [Char]
uri (options :: [([Char], [Char])]
options, (proxy :: [Char]
proxy, (strictInput :: Bool
strictInput, redirect :: Bool
redirect)))
= IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( ( Int -> [Char] -> IOSArrow XmlTree XmlTree
forall s b. Int -> [Char] -> IOStateArrow s b b
traceMsg 2 ( "get HTTP via native HTTP interface, uri=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
uri [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " options=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [([Char], [Char])] -> [Char]
forall a. Show a => a -> [Char]
show [([Char], [Char])]
options )
IOSArrow XmlTree XmlTree
-> IOSLA
(XIOState ())
XmlTree
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
-> IOSLA
(XIOState ())
XmlTree
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
IO
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
-> IOSLA
(XIOState ())
XmlTree
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
forall (a :: * -> * -> *) c b. ArrowIO a => IO c -> a b c
arrIO0 (Bool
-> [Char]
-> [Char]
-> Bool
-> [([Char], [Char])]
-> IO
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
getCont Bool
strictInput [Char]
proxy [Char]
uri Bool
redirect [([Char], [Char])]
options)
)
IOSLA
(XIOState ())
XmlTree
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
-> IOSLA
(XIOState ())
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
(IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
( (([([Char], [Char])], [Char]) -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([([Char], [Char])], [Char])
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([([Char], [Char])] -> [Char] -> IOSArrow XmlTree XmlTree)
-> ([([Char], [Char])], [Char]) -> IOSArrow XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [([Char], [Char])] -> [Char] -> IOSArrow XmlTree XmlTree
forall s.
[([Char], [Char])] -> [Char] -> IOStateArrow s XmlTree XmlTree
addInputError)
IOSLA
(XIOState ())
([([Char], [Char])], [Char])
(IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([([Char], [Char])], ByteString)
(IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
(Either
([([Char], [Char])], [Char]) ([([Char], [Char])], ByteString))
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
(([([Char], [Char])], ByteString) -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([([Char], [Char])], ByteString)
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([([Char], [Char])], ByteString) -> IOSArrow XmlTree XmlTree
addContent
)
)
addContent :: (Attributes, B.ByteString) -> IOSArrow XmlTree XmlTree
addContent :: ([([Char], [Char])], ByteString) -> IOSArrow XmlTree XmlTree
addContent (al :: [([Char], [Char])]
al, bc :: ByteString
bc)
= IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (ByteString -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
ByteString -> a n XmlTree
blb ByteString
bc)
IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[IOSArrow XmlTree XmlTree] -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => [a b b] -> a b b
seqA ((([Char], [Char]) -> IOSArrow XmlTree XmlTree)
-> [([Char], [Char])] -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [Char] -> IOSArrow XmlTree XmlTree)
-> ([Char], [Char]) -> IOSArrow XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [Char] -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
[Char] -> [Char] -> a XmlTree XmlTree
addAttr) [([Char], [Char])]
al)
a_use_http :: String
a_use_http :: [Char]
a_use_http = "use-http"
withHTTP :: Attributes -> SysConfig
withHTTP :: [([Char], [Char])] -> SysConfig
withHTTP httpOpts :: [([Char], [Char])]
httpOpts = Selector XIOSysState (IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState (IOSArrow XmlTree XmlTree)
theHttpHandler IOSArrow XmlTree XmlTree
getHTTPNativeContents
SysConfig -> SysConfig -> SysConfig
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[([Char], [Char])] -> SysConfig
withInputOptions [([Char], [Char])]
httpOpts
httpOptions :: [OptDescr SysConfig]
httpOptions :: [OptDescr SysConfig]
httpOptions = [ [Char]
-> [[Char]] -> ArgDescr SysConfig -> [Char] -> OptDescr SysConfig
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option "" [[Char]
a_use_http] (SysConfig -> ArgDescr SysConfig
forall a. a -> ArgDescr a
NoArg ([([Char], [Char])] -> SysConfig
withHTTP [])) "enable HTTP input with native Haskell HTTP package" ]