Skip to content

Instantly share code, notes, and snippets.

@twoolie

twoolie/hget.hs Secret

Created July 21, 2013 06:32
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save twoolie/5c51f280910f52a1e727 to your computer and use it in GitHub Desktop.
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