packages feed

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 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>