From e34f6951f1265c9120fb31bb07ebdf0b7a834a6b Mon Sep 17 00:00:00 2001 From: Joshua Clayton Date: Wed, 4 May 2016 22:55:09 -0400 Subject: [PATCH] Add optparse-applicative for flags This introduces the optparse-applicative library for parsing out any subcommands/flags/args. Currently only supports --no-progress (-P). --- app/Main.hs | 165 +++++------------------- src/Unused/CLI.hs | 11 ++ src/Unused/CLI/Search.hs | 33 +++++ src/Unused/CLI/SearchError.hs | 24 ++++ src/Unused/CLI/SearchResult.hs | 62 +++++++++ src/Unused/CLI/SearchWithProgress.hs | 40 ++++++ src/Unused/CLI/SearchWithoutProgress.hs | 9 ++ src/Unused/CLI/Util.hs | 11 ++ unused.cabal | 15 ++- 9 files changed, 230 insertions(+), 140 deletions(-) create mode 100644 src/Unused/CLI.hs create mode 100644 src/Unused/CLI/Search.hs create mode 100644 src/Unused/CLI/SearchError.hs create mode 100644 src/Unused/CLI/SearchResult.hs create mode 100644 src/Unused/CLI/SearchWithProgress.hs create mode 100644 src/Unused/CLI/SearchWithoutProgress.hs create mode 100644 src/Unused/CLI/Util.hs diff --git a/app/Main.hs b/app/Main.hs index cd7cddd..8cf57d5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,150 +1,43 @@ module Main where -import Control.Monad.State +import Options.Applicative import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) -import System.Console.ANSI -import System.ProgressBar -import Text.Printf -import Unused.TermSearch (search) -import Unused.Parser (parseLines, ParseError) -import Unused.Types +import Unused.Parser (parseLines) +import Unused.Types (withOneOccurrence, withOneFile) +import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen) + +data Options = Options + { oSearchRunner :: SearchRunner + } main :: IO () -main = do +main = run =<< execParser + (parseOptions `withInfo` "Analyze potentially unused code") + +run :: Options -> IO () +run options = do + hSetBuffering stdout NoBuffering + terms <- pure . lines =<< getContents - results <- executeSearch terms + results <- executeSearch (oSearchRunner options) terms let response = parseLines $ unlines results resetScreen - case withOneOccurrence $ withOneFile response of - Right termMatchSet -> do - mapM_ (printDirectorySection $ maxWidth) responses - where - responses = responsesGroupedByPath termMatchSet - allSets = listFromMatchSet =<< map snd responses - allResults = fmap snd allSets - termLength = return . length . tmTerm - maxWidth = maximum $ termLength =<< trMatches =<< allResults - Left e -> - printParseError e + + either printParseError printSearchResults $ + withOneOccurrence $ withOneFile response return () -executeSearch :: [String] -> IO [String] -executeSearch terms = do - resetScreen - printAnalysisHeader terms - (results, _) <- runStateT (performSearch $ length terms) terms - resetScreen +withInfo :: Parser a -> String -> ParserInfo a +withInfo opts desc = info (helper <*> opts) $ progDesc desc - return $ concat results +parseOptions :: Parser Options +parseOptions = + Options + <$> parseSearchRunner + (short 'P' <> long "no-progress" <> help "Don't display progress during analysis") -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" - -printDirectorySection :: Int -> (DirectoryPrefix, TermMatchSet) -> IO () -printDirectorySection w (dir, ss) = do - printDirectory dir - mapM_ (printTermResults w) $ listFromMatchSet ss - putStr "\n" - -printDirectory :: DirectoryPrefix -> IO () -printDirectory (DirectoryPrefix dir) = do - setSGR [SetColor Foreground Vivid Black] - setSGR [SetConsoleIntensity BoldIntensity] - putStrLn dir - setSGR [Reset] - -printTermResults :: Int -> (String, TermResults) -> IO () -printTermResults w (_, results) = - printMatches w results $ trMatches results - -likelihoodColor :: RemovalLikelihood -> Color -likelihoodColor High = Red -likelihoodColor Medium = Yellow -likelihoodColor Low = Green - -printMatches :: Int -> TermResults -> [TermMatch] -> IO () -printMatches w r ms = - forM_ ms $ \m -> do - setSGR [SetColor Foreground Dull (likelihoodColor $ trRemovalLikelihood r)] - setSGR [SetConsoleIntensity NormalIntensity] - putStr $ " " ++ (printf termFormat $ tmTerm m) - setSGR [Reset] - - setSGR [SetColor Foreground Vivid Cyan] - setSGR [SetConsoleIntensity NormalIntensity] - putStr $ (printNumber $ trTotalFiles r) ++ "," ++ (printNumber $ trTotalOccurrences r) ++ " " - setSGR [Reset] - - setSGR [SetColor Foreground Dull Cyan] - setSGR [SetConsoleIntensity FaintIntensity] - putStr $ " " ++ tmPath m - setSGR [Reset] - putStr "\n" - where - termFormat = "%-" ++ (show w) ++ "s" - printNumber = printf "%2d" - -printParseError :: ParseError -> IO () -printParseError e = do - setSGR [SetColor Background Vivid Red] - setSGR [SetColor Foreground Vivid White] - setSGR [SetConsoleIntensity BoldIntensity] - - putStrLn "\nThere was a problem parsing the data:\n" - - setSGR [Reset] - - setSGR [SetColor Foreground Vivid Red] - setSGR [SetConsoleIntensity BoldIntensity] - - print e - putStr "\n" - - setSGR [Reset] - -resetScreen :: IO () -resetScreen = do - clearScreen - setCursorPosition 0 0 +parseSearchRunner :: Mod FlagFields SearchRunner -> Parser SearchRunner +parseSearchRunner = + flag SearchWithProgress SearchWithoutProgress diff --git a/src/Unused/CLI.hs b/src/Unused/CLI.hs new file mode 100644 index 0000000..0430744 --- /dev/null +++ b/src/Unused/CLI.hs @@ -0,0 +1,11 @@ +module Unused.CLI + ( module Unused.CLI.Search + , module Unused.CLI.SearchError + , module Unused.CLI.SearchResult + , module Unused.CLI.Util + ) where + +import Unused.CLI.Search +import Unused.CLI.SearchError +import Unused.CLI.SearchResult +import Unused.CLI.Util diff --git a/src/Unused/CLI/Search.hs b/src/Unused/CLI/Search.hs new file mode 100644 index 0000000..092f307 --- /dev/null +++ b/src/Unused/CLI/Search.hs @@ -0,0 +1,33 @@ +module Unused.CLI.Search + ( SearchRunner(..) + , executeSearch + ) where + +import Unused.CLI.SearchWithProgress (searchWithProgressBar) +import Unused.CLI.SearchWithoutProgress (searchWithoutProgressBar) +import Unused.CLI.Util + +data SearchRunner = SearchWithProgress | SearchWithoutProgress + +executeSearch :: SearchRunner -> [String] -> IO [String] +executeSearch runner terms = do + resetScreen + printAnalysisHeader terms + runSearch runner terms <* resetScreen + +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" + +runSearch :: SearchRunner -> ([String] -> IO [String]) +runSearch SearchWithProgress = searchWithProgressBar +runSearch SearchWithoutProgress = searchWithoutProgressBar diff --git a/src/Unused/CLI/SearchError.hs b/src/Unused/CLI/SearchError.hs new file mode 100644 index 0000000..a65dbe3 --- /dev/null +++ b/src/Unused/CLI/SearchError.hs @@ -0,0 +1,24 @@ +module Unused.CLI.SearchError + ( printParseError + ) where + +import Unused.Parser (ParseError) +import Unused.CLI.Util + +printParseError :: ParseError -> IO () +printParseError e = do + setSGR [SetColor Background Vivid Red] + setSGR [SetColor Foreground Vivid White] + setSGR [SetConsoleIntensity BoldIntensity] + + putStrLn "\nThere was a problem parsing the data:\n" + + setSGR [Reset] + + setSGR [SetColor Foreground Vivid Red] + setSGR [SetConsoleIntensity BoldIntensity] + + print e + putStr "\n" + + setSGR [Reset] diff --git a/src/Unused/CLI/SearchResult.hs b/src/Unused/CLI/SearchResult.hs new file mode 100644 index 0000000..b39c630 --- /dev/null +++ b/src/Unused/CLI/SearchResult.hs @@ -0,0 +1,62 @@ +module Unused.CLI.SearchResult + ( printSearchResults + ) where + +import Control.Monad (forM_) +import Text.Printf +import Unused.Types +import Unused.CLI.Util + +printSearchResults :: TermMatchSet -> IO () +printSearchResults termMatchSet = + mapM_ (printDirectorySection maxWidth) responses + where + responses = responsesGroupedByPath termMatchSet + allSets = listFromMatchSet =<< map snd responses + allResults = map snd allSets + termLength = return . length . tmTerm + maxWidth = maximum $ termLength =<< trMatches =<< allResults + +printDirectorySection :: Int -> (DirectoryPrefix, TermMatchSet) -> IO () +printDirectorySection w (dir, ss) = do + printDirectory dir + mapM_ (printTermResults w) $ listFromMatchSet ss + putStr "\n" + +printDirectory :: DirectoryPrefix -> IO () +printDirectory (DirectoryPrefix dir) = do + setSGR [SetColor Foreground Vivid Black] + setSGR [SetConsoleIntensity BoldIntensity] + putStrLn dir + setSGR [Reset] + +printTermResults :: Int -> (String, TermResults) -> IO () +printTermResults w (_, results) = + printMatches w results $ trMatches results + +likelihoodColor :: RemovalLikelihood -> Color +likelihoodColor High = Red +likelihoodColor Medium = Yellow +likelihoodColor Low = Green + +printMatches :: Int -> TermResults -> [TermMatch] -> IO () +printMatches w r ms = + forM_ ms $ \m -> do + setSGR [SetColor Foreground Dull (likelihoodColor $ trRemovalLikelihood r)] + setSGR [SetConsoleIntensity NormalIntensity] + putStr $ " " ++ (printf termFormat $ tmTerm m) + setSGR [Reset] + + setSGR [SetColor Foreground Vivid Cyan] + setSGR [SetConsoleIntensity NormalIntensity] + putStr $ (printNumber $ trTotalFiles r) ++ "," ++ (printNumber $ trTotalOccurrences r) ++ " " + setSGR [Reset] + + setSGR [SetColor Foreground Dull Cyan] + setSGR [SetConsoleIntensity FaintIntensity] + putStr $ " " ++ tmPath m + setSGR [Reset] + putStr "\n" + where + termFormat = "%-" ++ (show w) ++ "s" + printNumber = printf "%2d" diff --git a/src/Unused/CLI/SearchWithProgress.hs b/src/Unused/CLI/SearchWithProgress.hs new file mode 100644 index 0000000..0112201 --- /dev/null +++ b/src/Unused/CLI/SearchWithProgress.hs @@ -0,0 +1,40 @@ +module Unused.CLI.SearchWithProgress + ( searchWithProgressBar + ) where + +import Control.Monad.State +import System.ProgressBar +import Unused.TermSearch (search) + +searchWithProgressBar :: [String] -> IO [String] +searchWithProgressBar terms = + (concat . fst) <$> runStateT (performSearch $ length terms) terms + +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 + + progressBar (msg message) percentage progressBarWidth (toInteger complete) (toInteger total) diff --git a/src/Unused/CLI/SearchWithoutProgress.hs b/src/Unused/CLI/SearchWithoutProgress.hs new file mode 100644 index 0000000..2f6f8b9 --- /dev/null +++ b/src/Unused/CLI/SearchWithoutProgress.hs @@ -0,0 +1,9 @@ +module Unused.CLI.SearchWithoutProgress + ( searchWithoutProgressBar + ) where + +import Unused.TermSearch (search) + +searchWithoutProgressBar :: [String] -> IO [String] +searchWithoutProgressBar terms = + concat <$> mapM search terms diff --git a/src/Unused/CLI/Util.hs b/src/Unused/CLI/Util.hs new file mode 100644 index 0000000..f509a25 --- /dev/null +++ b/src/Unused/CLI/Util.hs @@ -0,0 +1,11 @@ +module Unused.CLI.Util + ( resetScreen + , module System.Console.ANSI + ) where + +import System.Console.ANSI + +resetScreen :: IO () +resetScreen = do + clearScreen + setCursorPosition 0 0 diff --git a/unused.cabal b/unused.cabal index 829d501..26b288d 100644 --- a/unused.cabal +++ b/unused.cabal @@ -20,12 +20,22 @@ library , Unused.Types , Unused.Util , Unused.Regex + , Unused.CLI + , Unused.CLI.Search + , Unused.CLI.SearchError + , Unused.CLI.SearchResult + , Unused.CLI.SearchWithProgress + , Unused.CLI.SearchWithoutProgress + , Unused.CLI.Util build-depends: base >= 4.7 && < 5 , process , parsec , containers , filepath , regex-tdfa + , mtl + , terminal-progress-bar + , ansi-terminal default-language: Haskell2010 executable unused @@ -34,10 +44,7 @@ executable unused ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: base , unused - , ansi-terminal - , containers - , terminal-progress-bar - , mtl + , optparse-applicative default-language: Haskell2010 test-suite unused-test