{-# LANGUAGE CPP #-}
module Network.HTTP.Directory
( httpDirectory,
httpFileSize,
httpRedirect,
httpRedirects
) where
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Text (Text)
import Network.HTTP.Client (hrRedirects, httpLbs, httpNoBody, Manager, method,
parseRequest, responseBody, responseHeaders,
responseOpenHistory, responseStatus)
import Network.HTTP.Types (hContentLength, hLocation, statusCode)
import Text.HTML.DOM (parseLBS)
import Text.XML.Cursor
httpDirectory :: Manager -> String -> IO [Text]
httpDirectory mgr url = do
request <- parseRequest url
response <- httpLbs request mgr
if statusCode (responseStatus response) /= 200
then error $ show $ responseStatus response
else do
let body = responseBody response
doc = parseLBS body
cursor = fromDocument doc
return $ concatMap (attribute "href") $ cursor $// element "a"
httpFileSize :: Manager -> String -> IO (Maybe Integer)
httpFileSize mgr url = do
request <- parseRequest url
response <- httpNoBody (request {method = "HEAD"}) mgr
if statusCode (responseStatus response) /= 200
then error $ show $ responseStatus response
else do
let headers = responseHeaders response
return $ read . B.unpack <$> lookup hContentLength headers
httpRedirects :: Manager -> String -> IO [B.ByteString]
httpRedirects mgr url = do
request <- parseRequest url
respHist <- responseOpenHistory (request {method = "HEAD"}) mgr
return $ reverse $ mapMaybe (lookup hLocation . responseHeaders . snd) $ hrRedirects respHist
httpRedirect :: Manager -> String -> IO (Maybe B.ByteString)
httpRedirect mgr url =
listToMaybe <$> httpRedirects mgr url