File: Example.hs

package info (click to toggle)
haskell-bytestring-progress 1.0.3-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 72 kB
  • sloc: haskell: 253; makefile: 2
file content (62 lines) | stat: -rw-r--r-- 2,639 bytes parent folder | download | duplicates (6)
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"