Display recent git SHAs per token

This creates a new "list" output format that includes a certain number
of git SHAs per token. This allows for perusal of the most recent
changes for a given token to understand what changed.
This commit is contained in:
Joshua Clayton 2016-06-17 18:44:27 -04:00
parent ce9b3b8a13
commit b65de02efc
17 changed files with 323 additions and 60 deletions

View File

@ -10,6 +10,7 @@ module App
import qualified Data.Bifunctor as B
import Control.Monad.Reader
import Control.Monad.Except
import Data.Maybe (isJust)
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
import Unused.Types (TermMatchSet, RemovalLikelihood(..))
import Unused.TermSearch (SearchResults(..), fromResults)
@ -19,7 +20,7 @@ import Unused.TagsSource
import Unused.ResultsClassifier
import Unused.Aliases (termsAndAliases)
import Unused.Parser (parseResults)
import Unused.CLI (SearchRunner(..), renderHeader, executeSearch, withRuntime)
import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime)
import qualified Unused.CLI.Views as V
type AppConfig = MonadReader Options
@ -41,6 +42,7 @@ data Options = Options
, oGrouping :: CurrentGrouping
, oWithoutCache :: Bool
, oFromStdIn :: Bool
, oCommitCount :: Maybe Int
}
runProgram :: Options -> IO ()
@ -54,7 +56,7 @@ run = do
liftIO $ renderHeader terms
results <- withCache . (`executeSearch` terms) =<< searchRunner
printResults . (`parseResults` results) =<< loadAllConfigs
printResults =<< retrieveGitContext =<< fmap (`parseResults` results) loadAllConfigs
termsWithAlternatesFromConfig :: App [String]
termsWithAlternatesFromConfig = do
@ -67,11 +69,19 @@ renderError :: AppError -> IO ()
renderError (TagError e) = V.missingTagsFileError e
renderError (InvalidConfigError e) = V.invalidConfigError e
retrieveGitContext :: TermMatchSet -> App TermMatchSet
retrieveGitContext tms = do
commitCount <- numberOfCommits
case commitCount of
Just c -> liftIO $ loadGitContext c tms
Nothing -> return tms
printResults :: TermMatchSet -> App ()
printResults ts = do
filters <- optionFilters ts
grouping <- groupingOptions
liftIO $ V.searchResults $ groupedResponses grouping filters
formatter <- resultFormatter
liftIO $ V.searchResults formatter $ groupedResponses grouping filters
loadAllConfigs :: App [LanguageConfiguration]
loadAllConfigs = do
@ -131,3 +141,13 @@ searchRunner = oSearchRunner <$> ask
runWithCache :: AppConfig m => m Bool
runWithCache = not . oWithoutCache <$> ask
numberOfCommits :: AppConfig m => m (Maybe Int)
numberOfCommits = oCommitCount <$> ask
resultFormatter :: AppConfig m => m V.ResultsFormat
resultFormatter = do
c <- numberOfCommits
return $ if isJust c
then V.List
else V.Column

View File

@ -6,6 +6,7 @@ import Data.Maybe (fromMaybe)
import Unused.Grouping (CurrentGrouping(..))
import Unused.Types (RemovalLikelihood(..))
import Unused.CLI (SearchRunner(..))
import Unused.Util (stringToInt)
main :: IO ()
main = runProgram =<< parseCLI
@ -35,6 +36,7 @@ parseOptions =
<*> parseGroupings
<*> parseWithoutCache
<*> parseFromStdIn
<*> parseCommitCount
parseSearchRunner :: Parser SearchRunner
parseSearchRunner =
@ -105,3 +107,11 @@ parseFromStdIn :: Parser Bool
parseFromStdIn = switch $
long "stdin"
<> help "Read tags from STDIN"
parseCommitCount :: Parser (Maybe Int)
parseCommitCount =
(stringToInt =<<) <$> commitParser
where
commitParser = optional $ strOption $
long "commits"
<> help "Number of recent commit SHAs to display per token"

View File

@ -3,4 +3,5 @@ module Unused.CLI
) where
import Unused.CLI.Search as X
import Unused.CLI.GitContext as X
import Unused.CLI.Util as X

View File

@ -0,0 +1,18 @@
module Unused.CLI.GitContext
( loadGitContext
) where
import Data.Map.Strict as Map (toList, fromList)
import Unused.Types (TermMatchSet)
import Unused.CLI.Util
import qualified Unused.CLI.Views as V
import Unused.CLI.ProgressIndicator
import Unused.GitContext
loadGitContext :: Int -> TermMatchSet -> IO TermMatchSet
loadGitContext i tms = do
resetScreen
V.loadingSHAsHeader i
Map.fromList <$> progressWithIndicator (gitContextForResults i) createProgressBar listTerms
where
listTerms = Map.toList tms

View File

@ -4,6 +4,7 @@ module Unused.CLI.Views
import Unused.CLI.Views.NoResultsFound as X
import Unused.CLI.Views.AnalysisHeader as X
import Unused.CLI.Views.GitSHAsHeader as X
import Unused.CLI.Views.MissingTagsFileError as X
import Unused.CLI.Views.InvalidConfigError as X
import Unused.CLI.Views.SearchResult as X

View File

@ -0,0 +1,18 @@
module Unused.CLI.Views.GitSHAsHeader
( loadingSHAsHeader
) where
import Unused.CLI.Util
loadingSHAsHeader :: Int -> IO ()
loadingSHAsHeader commitCount = do
setSGR [SetConsoleIntensity BoldIntensity]
putStr "Unused: "
setSGR [Reset]
putStr "loading the most recent "
setSGR [SetColor Foreground Dull Green]
putStr $ show commitCount
setSGR [Reset]
putStr " SHAs from git"

View File

@ -1,26 +1,26 @@
module Unused.CLI.Views.SearchResult
( searchResults
( ResultsFormat(..)
, searchResults
) where
import Control.Monad (forM_)
import Control.Arrow ((&&&))
import qualified Data.Map.Strict as Map
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Reader
import Unused.Types
import Unused.Grouping (Grouping(..), GroupedTerms)
import Unused.CLI.Views.SearchResult.ColumnFormatter
import Unused.CLI.Util
import Unused.CLI.Views.SearchResult.Types
import qualified Unused.CLI.Views.NoResultsFound as V
import qualified Unused.CLI.Views.SearchResult.ListResult as V
import qualified Unused.CLI.Views.SearchResult.TableResult as V
type ResultsPrinter = ReaderT ColumnFormat IO
searchResults :: [GroupedTerms] -> IO ()
searchResults terms = do
searchResults :: ResultsFormat -> [GroupedTerms] -> IO ()
searchResults format terms = do
resetScreen
runReaderT (printFormattedTerms terms) columnFormat
runReaderT (printFormattedTerms terms) resultsOptions
where
columnFormat = buildColumnFormatter $ termsToResults terms
columnFormatter = buildColumnFormatter $ termsToResults terms
resultsOptions = ResultsOptions columnFormatter format
termsToResults = concatMap (Map.elems . snd)
printFormattedTerms :: [GroupedTerms] -> ResultsPrinter ()
@ -49,38 +49,9 @@ printTermResults :: (String, TermResults) -> ResultsPrinter ()
printTermResults =
uncurry printMatches . (id &&& trMatches) . snd
likelihoodColor :: RemovalLikelihood -> Color
likelihoodColor High = Red
likelihoodColor Medium = Yellow
likelihoodColor Low = Green
likelihoodColor Unknown = Black
likelihoodColor NotCalculated = Magenta
printMatches :: TermResults -> [TermMatch] -> ResultsPrinter ()
printMatches r ms = do
cf <- ask
let printTerm = cfPrintTerm cf
let printPath = cfPrintPath cf
let printNumber = cfPrintNumber cf
liftIO $ forM_ ms $ \m -> do
setSGR [SetColor Foreground Dull (termColor r)]
setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printTerm (tmTerm m)
setSGR [Reset]
setSGR [SetColor Foreground Vivid Cyan]
setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printNumber (totalFileCount r) ++ ", " ++ printNumber (totalOccurrenceCount r)
setSGR [Reset]
setSGR [SetColor Foreground Dull Cyan]
setSGR [SetConsoleIntensity FaintIntensity]
putStr $ " " ++ printPath (tmPath m)
setSGR [Reset]
putStr $ " " ++ removalReason r
putStr "\n"
where
termColor = likelihoodColor . rLikelihood . trRemoval
removalReason = rReason . trRemoval
outputFormat' <- outputFormat
case outputFormat' of
Column -> V.printTable r ms
List -> V.printList r ms

View File

@ -0,0 +1,20 @@
module Unused.CLI.Views.SearchResult.Internal
( termColor
, removalReason
) where
import Unused.CLI.Util (Color(..))
import Unused.Types (TermResults(..), Removal(..), RemovalLikelihood(..))
termColor :: TermResults -> Color
termColor = likelihoodColor . rLikelihood . trRemoval
removalReason :: TermResults -> String
removalReason = rReason . trRemoval
likelihoodColor :: RemovalLikelihood -> Color
likelihoodColor High = Red
likelihoodColor Medium = Yellow
likelihoodColor Low = Green
likelihoodColor Unknown = Black
likelihoodColor NotCalculated = Magenta

View File

@ -0,0 +1,79 @@
module Unused.CLI.Views.SearchResult.ListResult
( printList
) where
import Control.Monad (forM_, void, when)
import Data.List (intercalate, (\\))
import Unused.CLI.Util
import Unused.Types
import Unused.CLI.Views.SearchResult.Internal
import Unused.CLI.Views.SearchResult.Types
printList :: TermResults -> [TermMatch] -> ResultsPrinter ()
printList r ms = liftIO $
forM_ ms $ \m -> do
printTermAndOccurrences r
printAliases r
printFilePath m
printSHAs r
printRemovalReason r
putStr "\n"
printTermAndOccurrences :: TermResults -> IO ()
printTermAndOccurrences r = do
setSGR [SetColor Foreground Dull (termColor r)]
setSGR [SetConsoleIntensity BoldIntensity]
putStr " "
setSGR [SetUnderlining SingleUnderline]
putStr $ trTerm r
setSGR [Reset]
setSGR [SetColor Foreground Vivid Cyan]
setSGR [SetConsoleIntensity NormalIntensity]
putStr " ("
putStr $ pluralize (totalFileCount r) "file" "files"
putStr ", "
putStr $ pluralize (totalOccurrenceCount r) "occurrence" "occurrences"
putStr ")"
setSGR [Reset]
putStr "\n"
printAliases :: TermResults -> IO ()
printAliases r = when anyAliases $ do
printHeader " Aliases: "
putStrLn $ intercalate ", " remainingAliases
where
anyAliases = not $ null remainingAliases
remainingAliases = trTerms r \\ [trTerm r]
printFilePath :: TermMatch -> IO ()
printFilePath m = do
printHeader " File Path: "
setSGR [SetColor Foreground Dull Cyan]
putStrLn $ tmPath m
setSGR [Reset]
printSHAs :: TermResults -> IO ()
printSHAs r =
case mshas of
Nothing -> void $ putStr ""
Just shas' -> do
printHeader " Recent SHAs: "
putStrLn $ intercalate ", " shas'
where
mshas = (map gcSha . gcCommits) <$> trGitContext r
printRemovalReason :: TermResults -> IO ()
printRemovalReason r = do
printHeader " Reason: "
putStrLn $ removalReason r
printHeader :: String -> IO ()
printHeader v = do
setSGR [SetConsoleIntensity BoldIntensity]
putStr v
setSGR [SetConsoleIntensity NormalIntensity]
pluralize :: Int -> String -> String -> String
pluralize i@1 singular _ = show i ++ " " ++ singular
pluralize i _ plural = show i ++ " " ++ plural

View File

@ -0,0 +1,35 @@
module Unused.CLI.Views.SearchResult.TableResult
( printTable
) where
import Control.Monad (forM_)
import Unused.Types
import Unused.CLI.Util
import Unused.CLI.Views.SearchResult.Internal
import Unused.CLI.Views.SearchResult.Types
printTable :: TermResults -> [TermMatch] -> ResultsPrinter ()
printTable r ms = do
cf <- columnFormat
let printTerm = cfPrintTerm cf
let printPath = cfPrintPath cf
let printNumber = cfPrintNumber cf
liftIO $ forM_ ms $ \m -> do
setSGR [SetColor Foreground Dull (termColor r)]
setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printTerm (tmTerm m)
setSGR [Reset]
setSGR [SetColor Foreground Vivid Cyan]
setSGR [SetConsoleIntensity NormalIntensity]
putStr $ " " ++ printNumber (totalFileCount r) ++ ", " ++ printNumber (totalOccurrenceCount r)
setSGR [Reset]
setSGR [SetColor Foreground Dull Cyan]
setSGR [SetConsoleIntensity FaintIntensity]
putStr $ " " ++ printPath (tmPath m)
setSGR [Reset]
putStr $ " " ++ removalReason r
putStr "\n"

View File

@ -0,0 +1,28 @@
module Unused.CLI.Views.SearchResult.Types
( ResultsOptions(..)
, ResultsFormat(..)
, ResultsPrinter
, ColumnFormat(..)
, columnFormat
, outputFormat
, R.runReaderT
, M.liftIO
) where
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.IO.Class as M
import Unused.CLI.Views.SearchResult.ColumnFormatter
data ResultsOptions = ResultsOptions
{ roColumnFormat :: ColumnFormat
, roOutputFormat :: ResultsFormat
}
data ResultsFormat = Column | List
type ResultsPrinter = R.ReaderT ResultsOptions IO
columnFormat :: ResultsPrinter ColumnFormat
columnFormat = roColumnFormat <$> R.ask
outputFormat :: ResultsPrinter ResultsFormat
outputFormat = roOutputFormat <$> R.ask

35
src/Unused/GitContext.hs Normal file
View File

@ -0,0 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
module Unused.GitContext
( gitContextForResults
) where
import qualified Data.Text as T
import qualified Data.List as L
import System.Process
import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases)
newtype GitOutput = GitOutput { unOutput :: String }
gitContextForResults :: Int -> (String, TermResults) -> IO [(String, TermResults)]
gitContextForResults commitCount a@(token, results) =
case removalLikelihood results of
High -> do
gitContext <- logToGitContext <$> gitLogSearchFor commitCount (resultAliases results)
return [(token, results { trGitContext = Just gitContext })]
_ -> return [a]
-- 58e219e Allow developer-authored configurations
-- 307dd20 Introduce internal yaml configuration of auto low likelihood match handling
-- 3b627ee Allow multiple matches with single-occurring appropriate tokens
-- f7a2e1a Add Hspec and tests around parsing
logToGitContext :: GitOutput -> GitContext
logToGitContext =
GitContext . map GitCommit . shaList . unOutput
where
shaList = map (T.unpack . head . T.splitOn " " . T.pack) . lines
gitLogSearchFor :: Int -> [String] -> IO GitOutput
gitLogSearchFor commitCount ts = do
(_, results, _) <- readProcessWithExitCode "git" ["log", "-G", L.intercalate "|" ts, "--oneline", "-n", show commitCount] ""
return $ GitOutput results

View File

@ -7,10 +7,14 @@ module Unused.Types
, RemovalLikelihood(..)
, Removal(..)
, Occurrences(..)
, GitContext(..)
, GitCommit(..)
, resultsFromMatches
, totalFileCount
, totalOccurrenceCount
, appOccurrenceCount
, removalLikelihood
, resultAliases
) where
import qualified Data.Map.Strict as Map
@ -41,6 +45,7 @@ data TermResults = TermResults
, trAppOccurrences :: Occurrences
, trTotalOccurrences :: Occurrences
, trRemoval :: Removal
, trGitContext :: Maybe GitContext
} deriving (Eq, Show)
data Removal = Removal
@ -48,6 +53,14 @@ data Removal = Removal
, rReason :: String
} deriving (Eq, Show)
data GitContext = GitContext
{ gcCommits :: [GitCommit]
} deriving (Eq, Show)
data GitCommit = GitCommit
{ gcSha :: String
} deriving (Eq, Show)
data RemovalLikelihood = High | Medium | Low | Unknown | NotCalculated deriving (Eq, Show)
type TermMatchSet = Map.Map String TermResults
@ -61,6 +74,12 @@ totalOccurrenceCount = oOccurrences . trTotalOccurrences
appOccurrenceCount :: TermResults -> Int
appOccurrenceCount = oOccurrences . trAppOccurrences
removalLikelihood :: TermResults -> RemovalLikelihood
removalLikelihood = rLikelihood . trRemoval
resultAliases :: TermResults -> [String]
resultAliases = trTerms
resultsFromMatches :: [TermMatch] -> TermResults
resultsFromMatches m =
TermResults
@ -71,6 +90,7 @@ resultsFromMatches m =
, trTestOccurrences = testOccurrence
, trTotalOccurrences = Occurrences (sum $ map oFiles [appOccurrence, testOccurrence]) (sum $ map oOccurrences [appOccurrence, testOccurrence])
, trRemoval = Removal NotCalculated "Likelihood not calculated"
, trGitContext = Nothing
}
where
testOccurrence = testOccurrences m

View File

@ -16,10 +16,10 @@ spec = parallel $
describe "calculateLikelihood" $ do
it "prefers language-specific checks first" $ do
let railsMatches = [ TermMatch "ApplicationController" "app/controllers/application_controller.rb" 1 ]
removalLikelihood railsMatches `shouldReturn` Low
removalLikelihood' railsMatches `shouldReturn` Low
let elixirMatches = [ TermMatch "AwesomeView" "web/views/awesome_view.ex" 1 ]
removalLikelihood elixirMatches `shouldReturn` Low
removalLikelihood' elixirMatches `shouldReturn` Low
it "weighs widely-used methods as low likelihood" $ do
let matches = [ TermMatch "full_name" "app/models/user.rb" 4
@ -28,19 +28,19 @@ spec = parallel $
, TermMatch "full_name" "spec/models/user_spec.rb" 10
]
removalLikelihood matches `shouldReturn` Low
removalLikelihood' matches `shouldReturn` Low
it "weighs only-used-once methods as high likelihood" $ do
let matches = [ TermMatch "obscure_method" "app/models/user.rb" 1 ]
removalLikelihood matches `shouldReturn` High
removalLikelihood' matches `shouldReturn` High
it "weighs methods that seem to only be tested and never used as high likelihood" $ do
let matches = [ TermMatch "obscure_method" "app/models/user.rb" 1
, TermMatch "obscure_method" "spec/models/user_spec.rb" 5
]
removalLikelihood matches `shouldReturn` High
removalLikelihood' matches `shouldReturn` High
it "weighs methods that seem to only be tested and used in one other area as medium likelihood" $ do
let matches = [ TermMatch "obscure_method" "app/models/user.rb" 1
@ -49,14 +49,14 @@ spec = parallel $
, TermMatch "obscure_method" "spec/controllers/user_controller_spec.rb" 5
]
removalLikelihood matches `shouldReturn` Medium
removalLikelihood' matches `shouldReturn` Medium
it "doesn't mis-categorize allowed terms from different languages" $ do
let matches = [ TermMatch "t" "web/models/foo.ex" 1 ]
removalLikelihood matches `shouldReturn` High
removalLikelihood' matches `shouldReturn` High
removalLikelihood :: [TermMatch] -> IO RemovalLikelihood
removalLikelihood ms = do
removalLikelihood' :: [TermMatch] -> IO RemovalLikelihood
removalLikelihood' ms = do
(Right config) <- loadConfig
return $ rLikelihood $ trRemoval $ calculateLikelihood config $ resultsFromMatches ms

View File

@ -18,10 +18,10 @@ spec = parallel $
, TermMatch "method_name" "app/path/other.rb" 5
, TermMatch "method_name" "spec/path/foo_spec.rb" 10
]
let r1Results = TermResults "method_name" ["method_name"] r1Matches (Occurrences 1 10) (Occurrences 2 6) (Occurrences 3 16) (Removal Low "used frequently")
let r1Results = TermResults "method_name" ["method_name"] r1Matches (Occurrences 1 10) (Occurrences 2 6) (Occurrences 3 16) (Removal Low "used frequently") Nothing
let r2Matches = [ TermMatch "other" "app/path/other.rb" 1 ]
let r2Results = TermResults "other" ["other"] r2Matches (Occurrences 0 0) (Occurrences 1 1) (Occurrences 1 1) (Removal High "used once")
let r2Results = TermResults "other" ["other"] r2Matches (Occurrences 0 0) (Occurrences 1 1) (Occurrences 1 1) (Removal High "used once") Nothing
(Right config) <- loadConfig
@ -35,7 +35,7 @@ spec = parallel $
, TermMatch "method_name" "app/path/other.rb" 5
, TermMatch "method_name" "spec/path/foo_spec.rb" 10
]
let r1Results = TermResults "method_name" ["method_name"] r1Matches (Occurrences 1 10) (Occurrences 2 6) (Occurrences 3 16) (Removal Low "used frequently")
let r1Results = TermResults "method_name" ["method_name"] r1Matches (Occurrences 1 10) (Occurrences 2 6) (Occurrences 3 16) (Removal Low "used frequently") Nothing
let result = parseResults [] $ SearchResults r1Matches
@ -55,7 +55,7 @@ spec = parallel $
let result = parseResults config $ SearchResults searchResults
let results = TermResults "admin?" ["admin?", "be_admin"] searchResults (Occurrences 2 4) (Occurrences 1 3) (Occurrences 3 7) (Removal Low "used frequently")
let results = TermResults "admin?" ["admin?", "be_admin"] searchResults (Occurrences 2 4) (Occurrences 1 3) (Occurrences 3 7) (Removal Low "used frequently") Nothing
result `shouldBe`
Map.fromList [ ("admin?|be_admin", results) ]

View File

@ -15,4 +15,4 @@ spec = parallel $
]
resultsFromMatches matches `shouldBe`
TermResults "ApplicationController" ["ApplicationController"] matches (Occurrences 1 10) (Occurrences 1 1) (Occurrences 2 11) (Removal NotCalculated "Likelihood not calculated")
TermResults "ApplicationController" ["ApplicationController"] matches (Occurrences 1 10) (Occurrences 1 1) (Occurrences 2 11) (Removal NotCalculated "Likelihood not calculated") Nothing

View File

@ -21,6 +21,7 @@ library
, Unused.TermSearch.Internal
, Unused.Parser
, Unused.Types
, Unused.GitContext
, Unused.Util
, Unused.Regex
, Unused.Aliases
@ -38,14 +39,20 @@ library
, Unused.TagsSource
, Unused.CLI
, Unused.CLI.Search
, Unused.CLI.GitContext
, Unused.CLI.Util
, Unused.CLI.Views
, Unused.CLI.Views.NoResultsFound
, Unused.CLI.Views.AnalysisHeader
, Unused.CLI.Views.GitSHAsHeader
, Unused.CLI.Views.MissingTagsFileError
, Unused.CLI.Views.InvalidConfigError
, Unused.CLI.Views.SearchResult
, Unused.CLI.Views.SearchResult.ColumnFormatter
, Unused.CLI.Views.SearchResult.Internal
, Unused.CLI.Views.SearchResult.ListResult
, Unused.CLI.Views.SearchResult.TableResult
, Unused.CLI.Views.SearchResult.Types
, Unused.CLI.ProgressIndicator
, Unused.CLI.ProgressIndicator.Internal
, Unused.CLI.ProgressIndicator.Types