From 2ec73ac3b33b8e049d510dc3687aaa7f21565674 Mon Sep 17 00:00:00 2001 From: Joshua Clayton Date: Fri, 13 May 2016 08:03:26 -0400 Subject: [PATCH] Consolidate progress indicator handling --- src/Unused/CLI/ProgressBar.hs | 33 ------------ src/Unused/CLI/ProgressIndicator.hs | 26 ++++++++++ src/Unused/CLI/ProgressIndicator/Internal.hs | 53 ++++++++++++++++++++ src/Unused/CLI/ProgressIndicator/Types.hs | 20 ++++++++ src/Unused/CLI/Search.hs | 10 ++-- src/Unused/CLI/SearchWithProgress.hs | 16 ------ src/Unused/CLI/SearchWithoutProgress.hs | 12 ----- src/Unused/CLI/Spinner.hs | 45 ----------------- unused.cabal | 7 ++- 9 files changed, 107 insertions(+), 115 deletions(-) delete mode 100644 src/Unused/CLI/ProgressBar.hs create mode 100644 src/Unused/CLI/ProgressIndicator.hs create mode 100644 src/Unused/CLI/ProgressIndicator/Internal.hs create mode 100644 src/Unused/CLI/ProgressIndicator/Types.hs delete mode 100644 src/Unused/CLI/SearchWithProgress.hs delete mode 100644 src/Unused/CLI/SearchWithoutProgress.hs delete mode 100644 src/Unused/CLI/Spinner.hs diff --git a/src/Unused/CLI/ProgressBar.hs b/src/Unused/CLI/ProgressBar.hs deleted file mode 100644 index 45273c4..0000000 --- a/src/Unused/CLI/ProgressBar.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Unused.CLI.ProgressBar - ( ProgressBar - , startProgressBar - , incrementProgressBar - , stopProgressBar - ) where - -import Control.Concurrent (ThreadId, killThread) -import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage) - -data ProgressBar = ProgressBar - { pbProgressRef :: ProgressRef - , pbThreadId :: ThreadId - } - -startProgressBar :: Int -> IO ProgressBar -startProgressBar i = do - (ref, tid) <- buildProgressBar $ toInteger i - return $ ProgressBar ref tid - -incrementProgressBar :: ProgressBar -> IO () -incrementProgressBar ProgressBar{ pbProgressRef = ref } = - incProgress ref 1 - -stopProgressBar :: ProgressBar -> IO () -stopProgressBar ProgressBar { pbThreadId = tid } = killThread tid - -buildProgressBar :: Integer -> IO (ProgressRef, ThreadId) -buildProgressBar = - startProgress (msg message) percentage progressBarWidth - where - message = "Working" - progressBarWidth = 60 diff --git a/src/Unused/CLI/ProgressIndicator.hs b/src/Unused/CLI/ProgressIndicator.hs new file mode 100644 index 0000000..0ca31f8 --- /dev/null +++ b/src/Unused/CLI/ProgressIndicator.hs @@ -0,0 +1,26 @@ +module Unused.CLI.ProgressIndicator + ( ProgressIndicator + , createProgressBar + , createSpinner + , progressWithIndicator + ) where + +import Unused.CLI.Util +import Unused.CLI.ProgressIndicator.Types +import Unused.CLI.ProgressIndicator.Internal + +createProgressBar :: ProgressIndicator +createProgressBar = ProgressBar Nothing Nothing + +createSpinner :: ProgressIndicator +createSpinner = + Spinner snapshots (length snapshots) 75000 colors Nothing + where + snapshots = ["⣾", "⣽", "⣻", "⢿", "⡿", "⣟", "⣯", "⣷"] + colors = cycle [Black, Red, Yellow, Green, Blue, Cyan, Magenta] + +progressWithIndicator :: (a -> IO [b]) -> ProgressIndicator -> [a] -> IO [b] +progressWithIndicator f i terms = do + printPrefix i + indicator <- start i $ length terms + concat <$> mapM (\t -> f t <* increment indicator) terms <* stop indicator diff --git a/src/Unused/CLI/ProgressIndicator/Internal.hs b/src/Unused/CLI/ProgressIndicator/Internal.hs new file mode 100644 index 0000000..24ae763 --- /dev/null +++ b/src/Unused/CLI/ProgressIndicator/Internal.hs @@ -0,0 +1,53 @@ +module Unused.CLI.ProgressIndicator.Internal + ( start + , stop + , increment + , printPrefix + ) where + +import Control.Monad (forever) +import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay) +import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage) +import Unused.CLI.ProgressIndicator.Types +import Unused.CLI.Util + +start :: ProgressIndicator -> Int -> IO ProgressIndicator +start s@Spinner{} _ = do + tid <- forkIO $ runSpinner 0 s + return $ s { sThreadId = Just tid } +start ProgressBar{} i = do + (ref, tid) <- buildProgressBar $ toInteger i + return $ ProgressBar (Just ref) (Just tid) + +stop :: ProgressIndicator -> IO () +stop ProgressBar{ pbThreadId = Just tid } = killThread tid +stop Spinner{ sThreadId = Just tid } = killThread tid +stop _ = return () + +increment :: ProgressIndicator -> IO () +increment ProgressBar{ pbProgressRef = Just ref } = incProgress ref 1 +increment _ = return () + +printPrefix :: ProgressIndicator -> IO () +printPrefix ProgressBar{} = putStr "\n\n" +printPrefix Spinner{} = putStr " " + +runSpinner :: Int -> ProgressIndicator -> IO () +runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = forever $ do + setSGR [SetColor Foreground Dull currentColor] + putStr currentSnapshot + cursorBackward 1 + threadDelay delay + runSpinner (i + 1) s + where + currentSnapshot = snapshots !! (i `mod` snapshotLength) + currentColor = colors !! (i `div` snapshotLength) + snapshotLength = length' +runSpinner _ _ = return () + +buildProgressBar :: Integer -> IO (ProgressRef, ThreadId) +buildProgressBar = + startProgress (msg message) percentage progressBarWidth + where + message = "Working" + progressBarWidth = 60 diff --git a/src/Unused/CLI/ProgressIndicator/Types.hs b/src/Unused/CLI/ProgressIndicator/Types.hs new file mode 100644 index 0000000..7e9caa8 --- /dev/null +++ b/src/Unused/CLI/ProgressIndicator/Types.hs @@ -0,0 +1,20 @@ +module Unused.CLI.ProgressIndicator.Types + ( ProgressIndicator(..) + ) where + +import Control.Concurrent (ThreadId) +import System.ProgressBar (ProgressRef) +import System.Console.ANSI (Color) + +data ProgressIndicator + = Spinner + { sSnapshots :: [String] + , sLength :: Int + , sDelay :: Int + , sColors :: [Color] + , sThreadId :: Maybe ThreadId + } + | ProgressBar + { pbProgressRef :: Maybe ProgressRef + , pbThreadId :: Maybe ThreadId + } diff --git a/src/Unused/CLI/Search.hs b/src/Unused/CLI/Search.hs index 8e66832..6e6d92a 100644 --- a/src/Unused/CLI/Search.hs +++ b/src/Unused/CLI/Search.hs @@ -3,9 +3,9 @@ module Unused.CLI.Search , executeSearch ) where -import Unused.CLI.SearchWithProgress (searchWithProgressBar) -import Unused.CLI.SearchWithoutProgress (searchWithoutProgressBar) +import Unused.TermSearch (search) import Unused.CLI.Util +import Unused.CLI.ProgressIndicator data SearchRunner = SearchWithProgress | SearchWithoutProgress @@ -29,6 +29,6 @@ printAnalysisHeader terms = do setSGR [Reset] putStr " terms" -runSearch :: SearchRunner -> ([String] -> IO [String]) -runSearch SearchWithProgress = searchWithProgressBar -runSearch SearchWithoutProgress = searchWithoutProgressBar +runSearch :: SearchRunner -> [String] -> IO [String] +runSearch SearchWithProgress = progressWithIndicator search createProgressBar +runSearch SearchWithoutProgress = progressWithIndicator search createSpinner diff --git a/src/Unused/CLI/SearchWithProgress.hs b/src/Unused/CLI/SearchWithProgress.hs deleted file mode 100644 index b4aca1b..0000000 --- a/src/Unused/CLI/SearchWithProgress.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Unused.CLI.SearchWithProgress - ( searchWithProgressBar - ) where - -import Unused.CLI.ProgressBar (ProgressBar, startProgressBar, incrementProgressBar, stopProgressBar) -import Unused.TermSearch (search) - -searchWithProgressBar :: [String] -> IO [String] -searchWithProgressBar terms = do - putStr "\n\n" - bar <- startProgressBar $ length terms - concat <$> mapM (performSearch bar) terms <* stopProgressBar bar - -performSearch :: ProgressBar -> String -> IO [String] -performSearch bar t = - search t <* incrementProgressBar bar diff --git a/src/Unused/CLI/SearchWithoutProgress.hs b/src/Unused/CLI/SearchWithoutProgress.hs deleted file mode 100644 index 6b4d059..0000000 --- a/src/Unused/CLI/SearchWithoutProgress.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Unused.CLI.SearchWithoutProgress - ( searchWithoutProgressBar - ) where - -import Unused.TermSearch (search) -import Unused.CLI.Spinner (startSpinner, stopSpinner) - -searchWithoutProgressBar :: [String] -> IO [String] -searchWithoutProgressBar terms = do - putStr " " - sp <- startSpinner - concat <$> mapM search terms <* stopSpinner sp diff --git a/src/Unused/CLI/Spinner.hs b/src/Unused/CLI/Spinner.hs deleted file mode 100644 index 7b70d03..0000000 --- a/src/Unused/CLI/Spinner.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Unused.CLI.Spinner - ( startSpinner - , stopSpinner - ) where - -import Control.Monad (forever) -import Control.Concurrent (ThreadId, killThread, threadDelay, forkIO) -import Unused.CLI.Util - -data Spinner = Spinner - { sSnapshots :: [String] - , sLength :: Int - , sDelay :: Int - , sColors :: [Color] - , sThreadId :: Maybe ThreadId - } - -startSpinner :: IO Spinner -startSpinner = do - let s = buildSpinner - tid <- forkIO $ runSpinner 0 s - return $ s { sThreadId = Just tid } - -stopSpinner :: Spinner -> IO () -stopSpinner Spinner{ sThreadId = Nothing } = return () -stopSpinner Spinner{ sThreadId = Just tid } = killThread tid - -buildSpinner :: Spinner -buildSpinner = - Spinner snapshots (length snapshots) 75000 colors Nothing - where - snapshots = ["⣾", "⣽", "⣻", "⢿", "⡿", "⣟", "⣯", "⣷"] - colors = cycle [Black, Red, Yellow, Green, Blue, Cyan, Magenta] - -runSpinner :: Int -> Spinner -> IO () -runSpinner i s = forever $ do - setSGR [SetColor Foreground Dull currentColor] - putStr currentSnapshot - cursorBackward 1 - threadDelay $ sDelay s - runSpinner (i + 1) s - where - currentSnapshot = sSnapshots s !! (i `mod` snapshotLength) - currentColor = sColors s !! (i `div` snapshotLength) - snapshotLength = sLength s diff --git a/unused.cabal b/unused.cabal index b09e2eb..cf0f7c3 100644 --- a/unused.cabal +++ b/unused.cabal @@ -29,11 +29,10 @@ library , Unused.CLI.SearchError , Unused.CLI.SearchResult , Unused.CLI.SearchResult.ColumnFormatter - , Unused.CLI.SearchWithProgress - , Unused.CLI.SearchWithoutProgress , Unused.CLI.Util - , Unused.CLI.Spinner - , Unused.CLI.ProgressBar + , Unused.CLI.ProgressIndicator + , Unused.CLI.ProgressIndicator.Internal + , Unused.CLI.ProgressIndicator.Types build-depends: base >= 4.7 && < 5 , process , parsec