content: -- ------------------------------------------------------------
  
  {- |
     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
      = 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)                  -- add the contents
        >>>
        seqA (map (uncurry addAttr) al)           -- add the meta info (HTTP headers, ...)
  
  -- ------------------------------------------------------------
  
  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" ]
  
  -- ------------------------------------------------------------
  
  