Use startProgress with incProgress instead of a state transformer

This commit is contained in:
Joshua Clayton 2016-05-05 21:36:21 -04:00
parent 88a1be8c32
commit e895420eb5

View File

@ -2,39 +2,22 @@ module Unused.CLI.SearchWithProgress
( searchWithProgressBar ( searchWithProgressBar
) where ) where
import Control.Monad.State import Control.Concurrent (ThreadId, killThread)
import System.ProgressBar import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage)
import Unused.TermSearch (search) import Unused.TermSearch (search)
searchWithProgressBar :: [String] -> IO [String] searchWithProgressBar :: [String] -> IO [String]
searchWithProgressBar terms = searchWithProgressBar terms = do
(concat . fst) <$> runStateT (performSearch $ length terms) terms (bar, tid) <- buildProgressBar $ toInteger $ length terms
concat <$> mapM (performSearch bar) terms <* killThread tid
performSearch :: Int -> StateT [String] IO [[String]] performSearch :: ProgressRef -> String -> IO [String]
performSearch total = do performSearch ref t =
currentTerm <- getSearchTerm search t <* incProgress ref 1
searchResults <- liftIO $ search currentTerm
remainingTerms <- get buildProgressBar :: Integer -> IO (ProgressRef, ThreadId)
let remaining = length remainingTerms buildProgressBar =
startProgress (msg message) percentage progressBarWidth
liftIO $ printProgressBar (total - remaining) total where
message = "Working"
if remaining > 0 progressBarWidth = 60
then do
res <- performSearch total
return $ searchResults:res
else return [searchResults]
getSearchTerm :: StateT [String] IO String
getSearchTerm = do
(x:xs) <- get
put xs
return x
printProgressBar :: Int -> Int -> IO ()
printProgressBar complete total = do
let message = "Working"
let progressBarWidth = 60
progressBar (msg message) percentage progressBarWidth (toInteger complete) (toInteger total)