mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Use startProgress with incProgress instead of a state transformer
This commit is contained in:
parent
88a1be8c32
commit
e895420eb5
@ -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)
|
|
||||||
|
Loading…
Reference in New Issue
Block a user