Consolidate progress indicator handling

src/Unused/CLI/ProgressBar.hs

@@ -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

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

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

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
+        }

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

src/Unused/CLI/SearchWithProgress.hs

@@ -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

src/Unused/CLI/SearchWithoutProgress.hs

@@ -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

src/Unused/CLI/Spinner.hs

@@ -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

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