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
|
module Main where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Options.Applicative
|
||||||
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
||||||
import System.Console.ANSI
|
import Unused.Parser (parseLines)
|
||||||
import System.ProgressBar
|
import Unused.Types (withOneOccurrence, withOneFile)
|
||||||
import Text.Printf
|
import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen)
|
||||||
import Unused.TermSearch (search)
|
|
||||||
import Unused.Parser (parseLines, ParseError)
|
data Options = Options
|
||||||
import Unused.Types
|
{ oSearchRunner :: SearchRunner
|
||||||
|
}
|
||||||
|
|
||||||
main :: IO ()
|
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
|
terms <- pure . lines =<< getContents
|
||||||
results <- executeSearch terms
|
results <- executeSearch (oSearchRunner options) terms
|
||||||
let response = parseLines $ unlines results
|
let response = parseLines $ unlines results
|
||||||
|
|
||||||
resetScreen
|
resetScreen
|
||||||
case withOneOccurrence $ withOneFile response of
|
|
||||||
Right termMatchSet -> do
|
either printParseError printSearchResults $
|
||||||
mapM_ (printDirectorySection $ maxWidth) responses
|
withOneOccurrence $ withOneFile response
|
||||||
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
|
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
executeSearch :: [String] -> IO [String]
|
withInfo :: Parser a -> String -> ParserInfo a
|
||||||
executeSearch terms = do
|
withInfo opts desc = info (helper <*> opts) $ progDesc desc
|
||||||
resetScreen
|
|
||||||
printAnalysisHeader terms
|
|
||||||
(results, _) <- runStateT (performSearch $ length terms) terms
|
|
||||||
resetScreen
|
|
||||||
|
|
||||||
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]]
|
parseSearchRunner :: Mod FlagFields SearchRunner -> Parser SearchRunner
|
||||||
performSearch total = do
|
parseSearchRunner =
|
||||||
currentTerm <- getSearchTerm
|
flag SearchWithProgress SearchWithoutProgress
|
||||||
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
|
|
||||||
|
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.Types
|
||||||
, Unused.Util
|
, Unused.Util
|
||||||
, Unused.Regex
|
, 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
|
build-depends: base >= 4.7 && < 5
|
||||||
, process
|
, process
|
||||||
, parsec
|
, parsec
|
||||||
, containers
|
, containers
|
||||||
, filepath
|
, filepath
|
||||||
, regex-tdfa
|
, regex-tdfa
|
||||||
|
, mtl
|
||||||
|
, terminal-progress-bar
|
||||||
|
, ansi-terminal
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable unused
|
executable unused
|
||||||
@ -34,10 +44,7 @@ executable unused
|
|||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, unused
|
, unused
|
||||||
, ansi-terminal
|
, optparse-applicative
|
||||||
, containers
|
|
||||||
, terminal-progress-bar
|
|
||||||
, mtl
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite unused-test
|
test-suite unused-test
|
||||||
|
Loading…
Reference in New Issue
Block a user