    -- ------------------------------------------------------------

    {- |
       Module     : Text.XML.HXT.Arrow.LibCurlInput
       Copyright  : Copyright (C) 2005 Uwe Schmidt
       License    : MIT

       Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
       Stability  : experimental
       Portability: portable

       libcurl input
    -}

    -- ------------------------------------------------------------

    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 qualified Data.ByteString.Lazy.Char8     as C

    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 c1 c2 b d.
    (c1 -> c2 -> IOSLA (XIOState ()) b d)
    -> IOSLA (XIOState ()) b (c1, c2) -> IOSLA (XIOState ()) b d
    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 b c c'.
    IOSLA (XIOState ()) b c
    -> IOSLA (XIOState ()) b c' -> IOSLA (XIOState ()) b (c, c')
    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 [Char]
    uri ([([Char], [Char])]
    options, ([Char]
    proxy, (Bool
    strictInput, Bool
    redirect)))
              = IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
    -> IOSArrow XmlTree XmlTree
    forall b c.
    IOSLA (XIOState ()) b (IOSLA (XIOState ()) b c)
    -> IOSLA (XIOState ()) b c
    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 Int
    2 ( [Char]
    "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]
    ++ [Char]
    " 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 c b. IO c -> IOSLA (XIOState ()) b c
    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 b c. (b -> c) -> IOSLA (XIOState ()) b c
    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 b d c.
    IOSLA (XIOState ()) b d
    -> IOSLA (XIOState ()) c d -> IOSLA (XIOState ()) (Either b c) d
    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 b c. (b -> c) -> IOSLA (XIOState ()) b c
    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 ([([Char], [Char])]
    al, ByteString
    bc)
        = IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
    forall (t :: * -> *) b.
    Tree t =>
    IOSLA (XIOState ()) (t b) (t b) -> IOSLA (XIOState ()) (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b) -> a (t b) (t b)
    replaceChildren (ByteString -> IOSArrow XmlTree XmlTree
    forall n. ByteString -> IOSLA (XIOState ()) n XmlTree
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    ByteString -> a n XmlTree
    blb ByteString
    bc)                  -- add the contents
          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 b. [IOSLA (XIOState ()) b b] -> IOSLA (XIOState ()) b b
    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)           -- add the meta info (HTTP headers, ...)

    -- ------------------------------------------------------------

    a_use_http              :: String
    a_use_http :: [Char]
    a_use_http              = [Char]
    "use-http"

    withHTTP               :: Attributes -> SysConfig
    withHTTP :: [([Char], [Char])] -> SysConfig
    withHTTP [([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]
    "" [[Char]
    a_use_http]  (SysConfig -> ArgDescr SysConfig
    forall a. a -> ArgDescr a
    NoArg ([([Char], [Char])] -> SysConfig
    withHTTP []))  [Char]
    "enable HTTP input with native Haskell HTTP package" ]

    -- ------------------------------------------------------------