secret
Created

A simple haskell file downloader (with stubbed main function)

  • Download Gist
hget.hs
Haskell
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
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
 
import qualified Data.Maybe as M
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import qualified Network.Http.Client as HTTP
import qualified System.Time as T
import qualified System.IO as IO
import qualified System.IO.Streams as S
import qualified System.IO.Streams.Combinators as SC
 
progressBar :: Int -> Int -> Int -> String
progressBar tot prog len = "[" ++ map outchar [1..len] ++ "]"
where cur = 1 + (prog * len `div` tot) :: Int
outchar n | n > cur = ' '
| n == cur = '>'
| n < cur = '='
 
type OutBS = S.OutputStream BS.ByteString
 
withProgressBar :: (Int -> Int -> String) -> Int -> (OutBS -> IO ()) -> (OutBS -> IO ())
-- :: (S.OutputStream C8.ByteString -> IO a0)
withProgressBar progressFunc length outHandler outStream = do
T.TOD secs _ <- T.getClockTime
(fmap fst $ SC.outputFoldM acc (0, secs) outStream) >>= outHandler
where
acc :: (Int, Integer) -> BS.ByteString -> IO (Int, Integer)
acc (lastSize, lastSecs) bs = do
let !progress = lastSize + BS.length bs
T.TOD currSecs _ <- T.getClockTime
if currSecs > lastSecs || progress == length
then (IO.hPutStr IO.stderr $ '\r' : progressFunc length progress) >> IO.hFlush IO.stderr
else return ()
return (progress, currSecs)
 
downloadFile :: HTTP.URL -> FilePath -> IO ()
downloadFile url name = HTTP.get url $ \response inStream -> do
let totalLength = HTTP.getHeader response "Content-Length"
status tot prog = "\r" ++ name ++ " " ++ progressBar tot prog 50 ++ " " ++ show prog ++ "/" ++ show tot
maybeProgress = M.maybe id (withProgressBar status . fst . M.fromJust . C8.readInt ) totalLength
case HTTP.getStatusCode response of
200 -> S.withFileAsOutput name $ maybeProgress $ S.connect inStream
code -> error $ "Failed to download " ++ name ++ ": http response returned " ++ show code
 
main = downloadFile "http://mirror.internode.on.net/pub/videos/linus-dunked.avi" "linus-dunked.avi"

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.