download file with http-streams and io-streams (with progressbar)

gistfile1.hs

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
import qualified Data.ByteString               as BS
import qualified Data.ByteString.Char8         as C8
import qualified System.IO.Streams.Combinators as SC
import Network.Socket (withSocketsDo)
import System.IO.Streams (InputStream, OutputStream, ReadTooShortException)
import Network.Http.Client
import qualified System.IO.Streams as S
import Data.Maybe
import Control.Exception (bracket)
import qualified System.IO as IO

displayProgress :: Int -> OutputStream BS.ByteString -> IO (OutputStream BS.ByteString)
displayProgress totalLength outStream = 
    fmap fst $ SC.outputFoldM acc 0 outStream
  where
    acc :: Int -> BS.ByteString -> IO Int
    acc last bs = do
      let progress = last + BS.length bs
      putStr $ "\r[" ++ progressbar progress 70 ++ "]"
      return progress
    progressbar prog len = map outchar [1..len]
      where cur = floor $ fromIntegral len * (fromIntegral prog / fromIntegral totalLength)
            outchar n | n >  cur = ' '
                      | n == cur = '>'
                      | n <  cur = '='

downloadFile url name = withSocketsDo $ get url $ \response inStream -> do
  let l = fromIntegral $ fst $ fromJust $ C8.readInteger $ fromJust $ getHeader response "Content-Length"
  bracket (IO.openBinaryFile name IO.WriteMode)
          (IO.hClose)
          (\h -> S.handleToOutputStream h >>= displayProgress l >>= S.connect inStream)

main :: IO ()
main = do
    let url = "http://audacity.googlecode.com/files/audacity-macosx-ub-2.0.3.dmg"
    print $ "Downloading " ++ url
    downloadFile (C8.pack url) "10MB2.zip"