MIN Avoid writing progress bar too fast

Updating once per second avoids having the drawing become a bottleneck
for very fast downloads.

NGLess/Utils/ProgressBar.hs

@@ -1,4 +1,4 @@
-{- Copyright 2014-2019 NGLess Authors
+{- Copyright 2014-2020 NGLess Authors
  - License: MIT
  -}
 
@@ -7,45 +7,49 @@ module Utils.ProgressBar
     , updateProgressBar
     ) where
 
-import Text.Printf
-import System.IO
-import Control.Monad (when)
+import qualified Text.Printf as TP
+import           System.IO (stdout, hFlush, hIsTerminalDevice)
+import qualified Data.Time as Time
 
-data ProgressBar = ProgressBar
+data ProgressBarData = ProgressBarData
     { pbarName :: String
     , cur :: Rational
+    , lastUpdated :: Time.UTCTime
     , width :: Int
-    , pbarActive :: Bool
     } deriving (Eq, Show)
 
+type ProgressBar = Maybe ProgressBarData
 
-noProgress :: ProgressBar
-noProgress = ProgressBar "" (-1) (-1) False
 
 -- | Redraw progress bar
+--
+-- If the last update was less than 1 second ago, then nothing is updated
 updateProgressBar :: ProgressBar -- ^ previous progressbar
                   -> Rational -- ^ current fractional progress
                   -> IO ProgressBar -- ^ new progressbar
-updateProgressBar bar _
-    | not (pbarActive bar) = return bar
-updateProgressBar bar progress = do
-    when (percent progress /= percent (cur bar)) $ do
-        let pmessage = drawProgressBar (width bar) progress ++ " " ++ printPercentage progress
-            m = pbarName bar ++ pmessage ++ "\r"
-        putStr m
-        hFlush stdout
-    return $ bar { cur = progress }
+updateProgressBar Nothing _ = return Nothing
+updateProgressBar (Just bar) progress = do
+    now <- Time.getCurrentTime
+    if (now `Time.diffUTCTime` lastUpdated bar) > 1 && (percent progress /= percent (cur bar))
+        then do
+            let pmessage = drawProgressBar (width bar) progress ++ " " ++ printPercentage progress
+                m = pbarName bar ++ pmessage ++ "\r"
+            putStr m
+            hFlush stdout
+            return . Just $ bar { cur = progress, lastUpdated = now }
+        else return (Just bar)
 
 -- | create a new 'ProgressBar' object
--- This function also checks if 'stdout' is a terminal device.
--- If it is not, then it returns a null progress bar,
--- one which does not draw on the screen.
+--
+-- This function also checks if 'stdout' is a terminal device. If it is not,
+-- then it returns a null progress bar, one which does not draw on the screen.
 mkProgressBar :: String -> Int -> IO ProgressBar
 mkProgressBar name w = do
     isTerm <- hIsTerminalDevice stdout
+    now <- Time.getCurrentTime
     return $! if isTerm
-        then ProgressBar name (-1) w True
-        else noProgress
+        then Just (ProgressBarData name (-1) now w)
+        else Nothing
 
 drawProgressBar :: Int -> Rational -> String
 drawProgressBar w progress =
@@ -57,5 +61,5 @@ percent :: Rational -> Int
 percent = round . (* 1000)
 
 printPercentage :: Rational -> String
-printPercentage progress = printf "%6.1f%%" (fromRational (progress * 100) :: Double)
+printPercentage progress = TP.printf "%6.1f%%" (fromRational (progress * 100) :: Double)