http-wget 0.4.0 → 0.4.1
raw patch · 2 files changed
+37/−5 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.HTTP.Wget: wget' :: (MonadIO m, MonadFailure WgetException m) => String -> [(String, String)] -> [(String, String)] -> m ([(String, String)], String)
Files
- Network/HTTP/Wget.hs +36/−4
- http-wget.cabal +1/−1
Network/HTTP/Wget.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PackageImports #-} --------------------------------------------------------- -- | -- Module : Network.HTTP.Wget@@ -15,6 +16,7 @@ --------------------------------------------------------- module Network.HTTP.Wget ( wget+ , wget' , WgetException (..) ) where @@ -23,10 +25,12 @@ import System.IO import Numeric (showHex) import Data.List (intercalate)-import Control.Monad.Trans+import "transformers" Control.Monad.Trans import Control.Failure import Control.Exception import Data.Generics+import Data.Char (isSpace)+import Control.Arrow (first, second) newtype WgetException = WgetException String deriving (Show, Typeable)@@ -38,7 +42,15 @@ -> [(String, String)] -- ^ Get parameters. -> [(String, String)] -- ^ Post parameters. If empty, this will be a get request. -> m String -- ^ The response body.-wget url get post = do+wget url get post = snd `fmap` wget' url get post++-- | Get a response from the given URL with the given parameters, including headers.+wget' :: (MonadIO m, MonadFailure WgetException m)+ => String -- ^ The URL.+ -> [(String, String)] -- ^ Get parameters.+ -> [(String, String)] -- ^ Post parameters. If empty, this will be a get request.+ -> m ([(String, String)], String) -- ^ The headers and response body.+wget' url get post = do let getSepChar :: Char getSepChar = if '?' `elem` url then '&' else '?' get' :: String@@ -49,12 +61,32 @@ else ["--post-data", urlEncodePairs post] (Nothing, Just hout, Just herr, phandle) <- liftIO $ createProcess $ (proc "wget"- ((url ++ get') : post' ++ ["-O", "-"])+ ((url ++ get') : post' ++ ["-O", "-", "--save-headers"]) ) { std_out = CreatePipe, std_err = CreatePipe } exitCode <- liftIO $ waitForProcess phandle case exitCode of- ExitSuccess -> liftIO $ hGetContents hout+ ExitSuccess -> liftIO $ parseHeaders `fmap` hGetContents hout _ -> liftIO (hGetContents herr) >>= failure . WgetException++parseHeaders :: String -> ([(String, String)], String)+parseHeaders = first (parseHeaders' . drop 1 . lines) . breakDoubleNewLine++breakDoubleNewLine :: String -> (String, String)+breakDoubleNewLine = first ($ "") . h where+ h :: String -> (String -> String, String)+ h ('\r':'\n':x) = h $ '\n' : x+ h ('\n':'\r':'\n':x) = h $ '\n':'\n':x+ h ('\n':'\n':x) = (id, x)+ h (c:x) =+ let (a, b) = h x+ in ((:) c . a, b)+ h [] = (id, "") -- though this should never happen++parseHeaders' :: [String] -> [(String, String)]+parseHeaders' = map helper where+ helper = second (dropWhile isSpace . dropColon) . break (== ':')+ dropColon (':':x) = x+ dropColon x = x urlEncodePairs :: [(String, String)] -> String urlEncodePairs = intercalate "&" . map urlEncodePair
http-wget.cabal view
@@ -1,5 +1,5 @@ name: http-wget-version: 0.4.0+version: 0.4.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>