mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Add optparse-applicative for flags
This introduces the optparse-applicative library for parsing out any subcommands/flags/args. Currently only supports --no-progress (-P).
This commit is contained in:
parent
6781ba1f5b
commit
e34f6951f1
165
app/Main.hs
165
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
|
||||
|
11
src/Unused/CLI.hs
Normal file
11
src/Unused/CLI.hs
Normal file
@ -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
|
33
src/Unused/CLI/Search.hs
Normal file
33
src/Unused/CLI/Search.hs
Normal file
@ -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
|
24
src/Unused/CLI/SearchError.hs
Normal file
24
src/Unused/CLI/SearchError.hs
Normal file
@ -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]
|
62
src/Unused/CLI/SearchResult.hs
Normal file
62
src/Unused/CLI/SearchResult.hs
Normal file
@ -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"
|
40
src/Unused/CLI/SearchWithProgress.hs
Normal file
40
src/Unused/CLI/SearchWithProgress.hs
Normal file
@ -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)
|
9
src/Unused/CLI/SearchWithoutProgress.hs
Normal file
9
src/Unused/CLI/SearchWithoutProgress.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module Unused.CLI.SearchWithoutProgress
|
||||
( searchWithoutProgressBar
|
||||
) where
|
||||
|
||||
import Unused.TermSearch (search)
|
||||
|
||||
searchWithoutProgressBar :: [String] -> IO [String]
|
||||
searchWithoutProgressBar terms =
|
||||
concat <$> mapM search terms
|
11
src/Unused/CLI/Util.hs
Normal file
11
src/Unused/CLI/Util.hs
Normal file
@ -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
|
15
unused.cabal
15
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
|
||||
|
Loading…
Reference in New Issue
Block a user