From b65de02efcee22126d70fa03deab0d1723181b2f Mon Sep 17 00:00:00 2001 From: Joshua Clayton Date: Fri, 17 Jun 2016 18:44:27 -0400 Subject: [PATCH] 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. --- app/App.hs | 26 +++++- app/Main.hs | 10 +++ src/Unused/CLI.hs | 1 + src/Unused/CLI/GitContext.hs | 18 +++++ src/Unused/CLI/Views.hs | 1 + src/Unused/CLI/Views/GitSHAsHeader.hs | 18 +++++ src/Unused/CLI/Views/SearchResult.hs | 57 ++++--------- src/Unused/CLI/Views/SearchResult/Internal.hs | 20 +++++ .../CLI/Views/SearchResult/ListResult.hs | 79 +++++++++++++++++++ .../CLI/Views/SearchResult/TableResult.hs | 35 ++++++++ src/Unused/CLI/Views/SearchResult/Types.hs | 28 +++++++ src/Unused/GitContext.hs | 35 ++++++++ src/Unused/Types.hs | 20 +++++ test/Unused/LikelihoodCalculatorSpec.hs | 18 ++--- test/Unused/ParserSpec.hs | 8 +- test/Unused/TypesSpec.hs | 2 +- unused.cabal | 7 ++ 17 files changed, 323 insertions(+), 60 deletions(-) create mode 100644 src/Unused/CLI/GitContext.hs create mode 100644 src/Unused/CLI/Views/GitSHAsHeader.hs create mode 100644 src/Unused/CLI/Views/SearchResult/Internal.hs create mode 100644 src/Unused/CLI/Views/SearchResult/ListResult.hs create mode 100644 src/Unused/CLI/Views/SearchResult/TableResult.hs create mode 100644 src/Unused/CLI/Views/SearchResult/Types.hs create mode 100644 src/Unused/GitContext.hs diff --git a/app/App.hs b/app/App.hs index 2bf9e9c..e63a739 100644 --- a/app/App.hs +++ b/app/App.hs @@ -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 diff --git a/app/Main.hs b/app/Main.hs index ea95863..8299c2d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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" diff --git a/src/Unused/CLI.hs b/src/Unused/CLI.hs index d927d29..7820321 100644 --- a/src/Unused/CLI.hs +++ b/src/Unused/CLI.hs @@ -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 diff --git a/src/Unused/CLI/GitContext.hs b/src/Unused/CLI/GitContext.hs new file mode 100644 index 0000000..8383d61 --- /dev/null +++ b/src/Unused/CLI/GitContext.hs @@ -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 diff --git a/src/Unused/CLI/Views.hs b/src/Unused/CLI/Views.hs index b110d59..256a5dc 100644 --- a/src/Unused/CLI/Views.hs +++ b/src/Unused/CLI/Views.hs @@ -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 diff --git a/src/Unused/CLI/Views/GitSHAsHeader.hs b/src/Unused/CLI/Views/GitSHAsHeader.hs new file mode 100644 index 0000000..907bf62 --- /dev/null +++ b/src/Unused/CLI/Views/GitSHAsHeader.hs @@ -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" diff --git a/src/Unused/CLI/Views/SearchResult.hs b/src/Unused/CLI/Views/SearchResult.hs index 601c12e..e9233b9 100644 --- a/src/Unused/CLI/Views/SearchResult.hs +++ b/src/Unused/CLI/Views/SearchResult.hs @@ -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 diff --git a/src/Unused/CLI/Views/SearchResult/Internal.hs b/src/Unused/CLI/Views/SearchResult/Internal.hs new file mode 100644 index 0000000..f9311cf --- /dev/null +++ b/src/Unused/CLI/Views/SearchResult/Internal.hs @@ -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 diff --git a/src/Unused/CLI/Views/SearchResult/ListResult.hs b/src/Unused/CLI/Views/SearchResult/ListResult.hs new file mode 100644 index 0000000..59e1f3f --- /dev/null +++ b/src/Unused/CLI/Views/SearchResult/ListResult.hs @@ -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 diff --git a/src/Unused/CLI/Views/SearchResult/TableResult.hs b/src/Unused/CLI/Views/SearchResult/TableResult.hs new file mode 100644 index 0000000..33dbbad --- /dev/null +++ b/src/Unused/CLI/Views/SearchResult/TableResult.hs @@ -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" diff --git a/src/Unused/CLI/Views/SearchResult/Types.hs b/src/Unused/CLI/Views/SearchResult/Types.hs new file mode 100644 index 0000000..5adfd5c --- /dev/null +++ b/src/Unused/CLI/Views/SearchResult/Types.hs @@ -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 diff --git a/src/Unused/GitContext.hs b/src/Unused/GitContext.hs new file mode 100644 index 0000000..74e2d21 --- /dev/null +++ b/src/Unused/GitContext.hs @@ -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 diff --git a/src/Unused/Types.hs b/src/Unused/Types.hs index d5c68e6..cbbb50f 100644 --- a/src/Unused/Types.hs +++ b/src/Unused/Types.hs @@ -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 diff --git a/test/Unused/LikelihoodCalculatorSpec.hs b/test/Unused/LikelihoodCalculatorSpec.hs index af65456..30010ba 100644 --- a/test/Unused/LikelihoodCalculatorSpec.hs +++ b/test/Unused/LikelihoodCalculatorSpec.hs @@ -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 diff --git a/test/Unused/ParserSpec.hs b/test/Unused/ParserSpec.hs index e49e7dc..202d82f 100644 --- a/test/Unused/ParserSpec.hs +++ b/test/Unused/ParserSpec.hs @@ -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) ] diff --git a/test/Unused/TypesSpec.hs b/test/Unused/TypesSpec.hs index 151c102..8d1508e 100644 --- a/test/Unused/TypesSpec.hs +++ b/test/Unused/TypesSpec.hs @@ -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 diff --git a/unused.cabal b/unused.cabal index 16e7d88..72d5944 100644 --- a/unused.cabal +++ b/unused.cabal @@ -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