1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
|
import Network.HTTP (simpleHTTP, Request, mkRequest)
import Network.HTTP.Base (Response(..), RequestMethod(..))
import Network.HTTP.Headers (HeaderName(..), findHeader)
import Network.Stream (ConnError)
import Network.URI (parseURI)
import Data.ByteString.Lazy.Progress (trackProgressString)
import qualified Data.ByteString.Lazy as BS
import System.IO (openBinaryFile, hClose, IOMode(..))
import System.IO (stderr)
import System.Environment (getArgs)
import System.ProgressBar (msg,noLabel)
import System.ProgressBar.ByteString (mkByteStringProgressWriter)
import System.ProgressBar.ByteString (fileReadProgressWriter)
downloadFile :: String -> FilePath -> IO ()
downloadFile url path = do
fhndl <- openBinaryFile path WriteMode
http <- simpleHTTP dbReq
case http of
Left x -> fail $ "Couldn't download file: " ++ show x
Right resp -> do
let size = read `fmap` findHeader HdrContentLength resp
putStrLn $ "Total size is " ++ show size ++ " bytes."
track <- trackProgressString formatStr size handler
track (rspBody resp) >>= BS.hPut fhndl
hClose fhndl
putStrLn "Done!"
where
dbReq = mkRequest GET link
Just link = parseURI url
formatStr = "\r Downloading file ... %p (%R, estimated done in %T)"
handler = putStr
downloadFile' :: String -> FilePath -> IO ()
downloadFile' url path = do
fhndl <- openBinaryFile path WriteMode
http <- simpleHTTP dbReq
case http of
Left x -> fail $ "Couldn't download file: " ++ show x
Right resp -> do
let Just size = read `fmap` findHeader HdrContentLength resp
putStrLn $ "Total size is " ++ show size ++ " bytes."
mkByteStringProgressWriter (rspBody resp) stderr 72 (fromIntegral size)
(msg "Downloading: ") noLabel
>>= BS.hPut fhndl
hClose fhndl
putStrLn "Done!"
where
dbReq = mkRequest GET link
Just link = parseURI url
formatStr = "\r Downloading file ... %p (%R, estimated done in %T)"
handler = putStr
main :: IO ()
main = do
downloadFile' "http://ftp.ndlug.nd.edu/pub/fedora/linux/releases/16/Fedora/x86_64/iso/Fedora-16-x86_64-netinst.iso" "foo.iso"
bs <- fileReadProgressWriter "foo.iso" stderr 78 (msg "Checksum comp: ")
noLabel
let checksum = BS.foldl' (+) 0 bs
putStrLn $ "Checksum: " ++ show checksum
downloadFile "http://ftp.ndlug.nd.edu/pub/fedora/linux/releases/16/Fedora/x86_64/iso/Fedora-16-x86_64-netinst.iso" "foo.iso"
|