mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Consolidate progress indicator handling
This commit is contained in:
parent
86cdd114d5
commit
2ec73ac3b3
@ -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
|
|
26
src/Unused/CLI/ProgressIndicator.hs
Normal file
26
src/Unused/CLI/ProgressIndicator.hs
Normal file
@ -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
|
53
src/Unused/CLI/ProgressIndicator/Internal.hs
Normal file
53
src/Unused/CLI/ProgressIndicator/Internal.hs
Normal file
@ -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
|
20
src/Unused/CLI/ProgressIndicator/Types.hs
Normal file
20
src/Unused/CLI/ProgressIndicator/Types.hs
Normal file
@ -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
|
||||||
|
}
|
@ -3,9 +3,9 @@ module Unused.CLI.Search
|
|||||||
, executeSearch
|
, executeSearch
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Unused.CLI.SearchWithProgress (searchWithProgressBar)
|
import Unused.TermSearch (search)
|
||||||
import Unused.CLI.SearchWithoutProgress (searchWithoutProgressBar)
|
|
||||||
import Unused.CLI.Util
|
import Unused.CLI.Util
|
||||||
|
import Unused.CLI.ProgressIndicator
|
||||||
|
|
||||||
data SearchRunner = SearchWithProgress | SearchWithoutProgress
|
data SearchRunner = SearchWithProgress | SearchWithoutProgress
|
||||||
|
|
||||||
@ -29,6 +29,6 @@ printAnalysisHeader terms = do
|
|||||||
setSGR [Reset]
|
setSGR [Reset]
|
||||||
putStr " terms"
|
putStr " terms"
|
||||||
|
|
||||||
runSearch :: SearchRunner -> ([String] -> IO [String])
|
runSearch :: SearchRunner -> [String] -> IO [String]
|
||||||
runSearch SearchWithProgress = searchWithProgressBar
|
runSearch SearchWithProgress = progressWithIndicator search createProgressBar
|
||||||
runSearch SearchWithoutProgress = searchWithoutProgressBar
|
runSearch SearchWithoutProgress = progressWithIndicator search createSpinner
|
||||||
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -29,11 +29,10 @@ library
|
|||||||
, Unused.CLI.SearchError
|
, Unused.CLI.SearchError
|
||||||
, Unused.CLI.SearchResult
|
, Unused.CLI.SearchResult
|
||||||
, Unused.CLI.SearchResult.ColumnFormatter
|
, Unused.CLI.SearchResult.ColumnFormatter
|
||||||
, Unused.CLI.SearchWithProgress
|
|
||||||
, Unused.CLI.SearchWithoutProgress
|
|
||||||
, Unused.CLI.Util
|
, Unused.CLI.Util
|
||||||
, Unused.CLI.Spinner
|
, Unused.CLI.ProgressIndicator
|
||||||
, Unused.CLI.ProgressBar
|
, Unused.CLI.ProgressIndicator.Internal
|
||||||
|
, Unused.CLI.ProgressIndicator.Types
|
||||||
build-depends: base >= 4.7 && < 5
|
build-depends: base >= 4.7 && < 5
|
||||||
, process
|
, process
|
||||||
, parsec
|
, parsec
|
||||||
|
Loading…
Reference in New Issue
Block a user