module Network.HTTP.Wget
( wget
) where
import System.Process
import System.Exit
import System.IO
import Numeric (showHex)
import Data.List (intercalate)
import Control.Monad.Trans
import Control.Monad.Attempt.Class
import Control.Exception
import Data.Generics
newtype WgetError = WgetError String
deriving (Show, Typeable)
instance Exception WgetError
wget :: (MonadIO m, MonadAttempt m)
=> String
-> [(String, String)]
-> [(String, String)]
-> m String
wget url get post = do
let getSepChar :: Char
getSepChar = if '?' `elem` url then '&' else '?'
get' :: String
get' = if null get then "" else getSepChar : urlEncodePairs get
post' :: [String]
post' = if null post
then []
else ["--post-data", urlEncodePairs post]
(Nothing, Just hout, Just herr, phandle) <- liftIO $
createProcess $ (proc "wget"
((url ++ get') : post' ++ ["-O", "-"])
) { std_out = CreatePipe, std_err = CreatePipe }
exitCode <- liftIO $ waitForProcess phandle
case exitCode of
ExitSuccess -> liftIO $ hGetContents hout
_ -> liftIO (hGetContents herr) >>= failure . WgetError
urlEncodePairs :: [(String, String)] -> String
urlEncodePairs = intercalate "&" . map urlEncodePair
urlEncodePair :: (String, String) -> String
urlEncodePair (x, y) = urlEncode x ++ '=' : urlEncode y
urlEncode :: String -> String
urlEncode = concatMap urlEncodeChar
urlEncodeChar :: Char -> String
urlEncodeChar x
| safeChar (fromEnum x) = return x
| otherwise = '%' : showHex (fromEnum x) ""
safeChar :: Int -> Bool
safeChar x
| x >= fromEnum 'a' && x <= fromEnum 'z' = True
| x >= fromEnum 'A' && x <= fromEnum 'Z' = True
| x >= fromEnum '0' && x <= fromEnum '9' = True
| otherwise = False