Skip to content

@twoolie /hget.hs secret
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
A simple haskell file downloader (with stubbed main function)
{-# 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"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.