gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}

module Downloader where

import           Control.Monad.IO.Class       (liftIO)
import           Control.Monad.Trans.Resource
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Char8        as C8
import           Data.Conduit
import qualified Data.Conduit.Binary          as CB
import           Network.HTTP.Conduit

contentLength :: Response body -> Integer
contentLength = read . C8.unpack . snd . head .
                filter ((== "Content-Length") . fst) . responseHeaders

reportProgress :: Integer -> (Double -> IO ()) ->
                 ConduitM BS.ByteString o (ResourceT IO) ()
reportProgress total updater =
  loop 0
  where
    loop len = await >>= maybe (return ()) (\bs -> do
        let currentBlocks = len + BS.length bs
        let percentage = fromIntegral (currentBlocks * 100) /
                         fromIntegral total
        liftIO $ updater percentage
        loop currentBlocks)

downloadFile :: String -> FilePath -> IO () -> (Double -> IO ()) -> IO ()
downloadFile url name done updater = withManager $ \manager -> do
    req <- parseUrl url
    let req' = req { requestHeaders = [("User-Agent", "wget/1.15")]}
    res <- http req' manager
    responseBody res $$+-
      CB.conduitFile name =$=
      reportProgress (contentLength res) updater
    done