module Text.XML.HXT.Arrow.LibCurlInput
( getLibCurlContents
, a_use_curl
, withCurl
, curlOptions
)
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 qualified Text.XML.HXT.IO.GetHTTPLibCurl as LibCURL
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
import Text.XML.HXT.Arrow.XmlOptions ( a_proxy
, a_redirect
)
getLibCurlContents :: IOSArrow XmlTree XmlTree
getLibCurlContents :: IOSArrow XmlTree XmlTree
getLibCurlContents
= String
-> ([(String, String)], (Bool, (String, Bool)))
-> IOSArrow XmlTree XmlTree
forall {a}.
Enum a =>
String
-> ([(String, String)], (a, (String, Bool)))
-> IOSArrow XmlTree XmlTree
getC
(String
-> ([(String, String)], (Bool, (String, Bool)))
-> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
XmlTree
(String, ([(String, String)], (Bool, (String, Bool))))
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
( String -> IOSLA (XIOState ()) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferURI
IOSLA (XIOState ()) XmlTree String
-> IOSLA
(XIOState ()) XmlTree ([(String, String)], (Bool, (String, Bool)))
-> IOSLA
(XIOState ())
XmlTree
(String, ([(String, String)], (Bool, (String, Bool))))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
Selector XIOSysState ([(String, String)], (Bool, (String, Bool)))
-> IOSLA
(XIOState ()) XmlTree ([(String, String)], (Bool, (String, Bool)))
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar (Selector XIOSysState [(String, String)]
theInputOptions Selector XIOSysState [(String, String)]
-> Selector XIOSysState (Bool, (String, Bool))
-> Selector
XIOSysState ([(String, String)], (Bool, (String, Bool)))
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState Bool
theRedirect Selector XIOSysState Bool
-> Selector XIOSysState (String, Bool)
-> Selector XIOSysState (Bool, (String, Bool))
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState String
theProxy Selector XIOSysState String
-> Selector XIOSysState Bool -> Selector XIOSysState (String, Bool)
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState Bool
theStrictInput
)
)
where
getC :: String
-> ([(String, String)], (a, (String, Bool)))
-> IOSArrow XmlTree XmlTree
getC String
uri ([(String, String)]
options, (a
redirect, (String
proxy, Bool
strictInput)))
= 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 -> String -> IOSArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 ( String
"get HTTP via libcurl, uri=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
uri String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" options=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
forall a. Show a => a -> String
show [(String, String)]
options' )
IOSArrow XmlTree XmlTree
-> IOSLA
(XIOState ())
XmlTree
(Either
([(String, String)], String) ([(String, String)], ByteString))
-> IOSLA
(XIOState ())
XmlTree
(Either
([(String, String)], String) ([(String, String)], 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
([(String, String)], String) ([(String, String)], ByteString))
-> IOSLA
(XIOState ())
XmlTree
(Either
([(String, String)], String) ([(String, String)], ByteString))
forall (a :: * -> * -> *) c b. ArrowIO a => IO c -> a b c
arrIO0 ( Bool
-> [(String, String)]
-> String
-> IO
(Either
([(String, String)], String) ([(String, String)], ByteString))
LibCURL.getCont
Bool
strictInput
[(String, String)]
options'
String
uri
)
)
IOSLA
(XIOState ())
XmlTree
(Either
([(String, String)], String) ([(String, String)], ByteString))
-> IOSLA
(XIOState ())
(Either
([(String, String)], String) ([(String, String)], 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
>>>
( (([(String, String)], String) -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([(String, String)], String)
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([(String, String)] -> String -> IOSArrow XmlTree XmlTree)
-> ([(String, String)], String) -> IOSArrow XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(String, String)] -> String -> IOSArrow XmlTree XmlTree
forall s.
[(String, String)] -> String -> IOStateArrow s XmlTree XmlTree
addInputError)
IOSLA
(XIOState ())
([(String, String)], String)
(IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([(String, String)], ByteString)
(IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
(Either
([(String, String)], String) ([(String, String)], ByteString))
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
(([(String, String)], ByteString) -> IOSArrow XmlTree XmlTree)
-> IOSLA
(XIOState ())
([(String, String)], ByteString)
(IOSArrow XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([(String, String)], ByteString) -> IOSArrow XmlTree XmlTree
addContent
)
)
where
options' :: [(String, String)]
options' = (String
a_proxy, String
proxy)
(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: (String
a_redirect, Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (a -> Int) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
redirect)
(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
options
addContent :: (Attributes, B.ByteString) -> IOSArrow XmlTree XmlTree
addContent :: ([(String, String)], ByteString) -> IOSArrow XmlTree XmlTree
addContent ([(String, String)]
al, 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 (((String, String) -> IOSArrow XmlTree XmlTree)
-> [(String, String)] -> [IOSArrow XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> IOSArrow XmlTree XmlTree)
-> (String, String) -> IOSArrow XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr) [(String, String)]
al)
a_use_curl :: String
a_use_curl :: String
a_use_curl = String
"use-curl"
withCurl :: Attributes -> SysConfig
withCurl :: [(String, String)] -> SysConfig
withCurl [(String, String)]
curlOpts = 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
getLibCurlContents
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
>>>
[(String, String)] -> SysConfig
withInputOptions [(String, String)]
curlOpts
curlOptions :: [OptDescr SysConfig]
curlOptions :: [OptDescr SysConfig]
curlOptions = [ String
-> [String] -> ArgDescr SysConfig -> String -> OptDescr SysConfig
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
a_use_curl] (SysConfig -> ArgDescr SysConfig
forall a. a -> ArgDescr a
NoArg ([(String, String)] -> SysConfig
withCurl [])) String
"enable HTTP input with libcurl" ]