Display progress bar when running ag

This commit is contained in:
Joshua Clayton 2016-05-01 16:40:28 -04:00
parent dcfaa9355e
commit 3ddf0631a9
2 changed files with 58 additions and 1 deletions

View File

@ -1,6 +1,9 @@
module Main where module Main where
import Control.Monad.State
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
import System.Console.ANSI import System.Console.ANSI
import System.ProgressBar
import Unused.TermSearch (search) import Unused.TermSearch (search)
import Unused.Parser (parseLines, ParseError) import Unused.Parser (parseLines, ParseError)
import Unused.Types import Unused.Types
@ -21,9 +24,56 @@ main = do
executeSearch :: [String] -> IO [String] executeSearch :: [String] -> IO [String]
executeSearch terms = do executeSearch terms = do
results <- mapM search terms resetScreen
printAnalysisHeader terms
(results, _) <- runStateT (performSearch $ length terms) terms
resetScreen
return $ concat results return $ concat results
performSearch :: Int -> StateT [String] IO [[String]]
performSearch total = do
currentTerm <- getSearchTerm
searchResults <- liftIO $ search currentTerm
remainingTerms <- get
let remaining = length remainingTerms
liftIO $ printProgressBar (total - remaining) total
if remaining > 0
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
hSetBuffering stdout NoBuffering
progressBar (msg message) percentage progressBarWidth (toInteger complete) (toInteger total)
printAnalysisHeader :: [String] -> IO ()
printAnalysisHeader terms = do
setSGR [SetConsoleIntensity BoldIntensity]
putStr "Unused: "
setSGR [Reset]
putStr "analyzing "
setSGR [SetColor Foreground Dull Green]
putStr $ show $ length terms
setSGR [Reset]
putStr " terms\n\n"
printMatchPair :: (String, [TermMatch]) -> IO () printMatchPair :: (String, [TermMatch]) -> IO ()
printMatchPair (term', matches) = do printMatchPair (term', matches) = do
setSGR [SetColor Foreground Vivid Red] setSGR [SetColor Foreground Vivid Red]
@ -62,3 +112,8 @@ printParseError e = do
putStr "\n" putStr "\n"
setSGR [Reset] setSGR [Reset]
resetScreen :: IO ()
resetScreen = do
clearScreen
setCursorPosition 0 0

View File

@ -33,6 +33,8 @@ executable unused
, unused , unused
, ansi-terminal , ansi-terminal
, containers , containers
, terminal-progress-bar
, mtl
default-language: Haskell2010 default-language: Haskell2010
test-suite unused-test test-suite unused-test