unused (empty) → 0.5.0.2
raw patch · 58 files changed
+2544/−0 lines, 58 filesdep +ansi-terminaldep +basedep +bytestringsetup-changed
Dependencies added: ansi-terminal, base, bytestring, cassava, containers, directory, filepath, hspec, mtl, optparse-applicative, parallel-io, process, regex-tdfa, terminal-progress-bar, text, transformers, unix, unordered-containers, unused, vector, yaml
Files
- LICENSE +7/−0
- Setup.hs +2/−0
- app/App.hs +159/−0
- app/Main.hs +117/−0
- data/config.yml +84/−0
- src/Unused/Aliases.hs +69/−0
- src/Unused/CLI.hs +7/−0
- src/Unused/CLI/GitContext.hs +18/−0
- src/Unused/CLI/ProgressIndicator.hs +30/−0
- src/Unused/CLI/ProgressIndicator/Internal.hs +53/−0
- src/Unused/CLI/ProgressIndicator/Types.hs +20/−0
- src/Unused/CLI/Search.hs +26/−0
- src/Unused/CLI/Util.hs +65/−0
- src/Unused/CLI/Views.hs +11/−0
- src/Unused/CLI/Views/AnalysisHeader.hs +18/−0
- src/Unused/CLI/Views/Error.hs +15/−0
- src/Unused/CLI/Views/FingerprintError.hs +19/−0
- src/Unused/CLI/Views/GitSHAsHeader.hs +18/−0
- src/Unused/CLI/Views/InvalidConfigError.hs +22/−0
- src/Unused/CLI/Views/MissingTagsFileError.hs +42/−0
- src/Unused/CLI/Views/NoResultsFound.hs +12/−0
- src/Unused/CLI/Views/SearchResult.hs +57/−0
- src/Unused/CLI/Views/SearchResult/ColumnFormatter.hs +45/−0
- src/Unused/CLI/Views/SearchResult/Internal.hs +20/−0
- src/Unused/CLI/Views/SearchResult/ListResult.hs +79/−0
- src/Unused/CLI/Views/SearchResult/TableResult.hs +35/−0
- src/Unused/CLI/Views/SearchResult/Types.hs +28/−0
- src/Unused/Cache.hs +50/−0
- src/Unused/Cache/DirectoryFingerprint.hs +53/−0
- src/Unused/Cache/FindArgsFromIgnoredPaths.hs +47/−0
- src/Unused/GitContext.hs +35/−0
- src/Unused/Grouping.hs +32/−0
- src/Unused/Grouping/Internal.hs +27/−0
- src/Unused/Grouping/Types.hs +20/−0
- src/Unused/LikelihoodCalculator.hs +46/−0
- src/Unused/Parser.hs +26/−0
- src/Unused/Regex.hs +13/−0
- src/Unused/ResponseFilter.hs +82/−0
- src/Unused/ResultsClassifier.hs +6/−0
- src/Unused/ResultsClassifier/Config.hs +45/−0
- src/Unused/ResultsClassifier/Types.hs +142/−0
- src/Unused/TagsSource.hs +40/−0
- src/Unused/TermSearch.hs +20/−0
- src/Unused/TermSearch/Internal.hs +34/−0
- src/Unused/TermSearch/Types.hs +13/−0
- src/Unused/Types.hs +133/−0
- src/Unused/Util.hs +36/−0
- test/Spec.hs +1/−0
- test/Unused/AliasesSpec.hs +21/−0
- test/Unused/Cache/FindArgsFromIgnoredPathsSpec.hs +27/−0
- test/Unused/Grouping/InternalSpec.hs +35/−0
- test/Unused/LikelihoodCalculatorSpec.hs +62/−0
- test/Unused/ParserSpec.hs +65/−0
- test/Unused/ResponseFilterSpec.hs +153/−0
- test/Unused/TermSearch/InternalSpec.hs +30/−0
- test/Unused/TypesSpec.hs +18/−0
- test/Unused/UtilSpec.hs +36/−0
- unused.cabal +118/−0
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright (c) 2016 Josh Clayton++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}++module App+ ( Options(..)+ , runProgram+ ) where++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)+import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)+import Unused.Cache+import Unused.TagsSource+import Unused.ResultsClassifier+import Unused.Aliases (termsAndAliases)+import Unused.Parser (parseResults)+import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime)+import qualified Unused.CLI.Views as V++type AppConfig = MonadReader Options++data AppError+ = TagError TagSearchOutcome+ | InvalidConfigError [ParseConfigError]+ | CacheError FingerprintOutcome++newtype App a = App {+ runApp :: ReaderT Options (ExceptT AppError IO) a+} deriving (Monad, Functor, Applicative, AppConfig, MonadError AppError, MonadIO)++data Options = Options+ { oSearchRunner :: SearchRunner+ , oSingleOccurrenceMatches :: Bool+ , oLikelihoods :: [RemovalLikelihood]+ , oAllLikelihoods :: Bool+ , oIgnoredPaths :: [String]+ , oGrouping :: CurrentGrouping+ , oWithoutCache :: Bool+ , oFromStdIn :: Bool+ , oCommitCount :: Maybe Int+ }++runProgram :: Options -> IO ()+runProgram options = withRuntime $+ runExceptT (runReaderT (runApp run) options) >>= either renderError return++run :: App ()+run = do+ terms <- termsWithAlternatesFromConfig++ liftIO $ renderHeader terms+ results <- withCache . (`executeSearch` terms) =<< searchRunner++ printResults =<< retrieveGitContext =<< fmap (`parseResults` results) loadAllConfigs++termsWithAlternatesFromConfig :: App [String]+termsWithAlternatesFromConfig = do+ aliases <- concatMap lcTermAliases <$> loadAllConfigs+ terms <- calculateTagInput++ return $ termsAndAliases aliases terms++renderError :: AppError -> IO ()+renderError (TagError e) = V.missingTagsFileError e+renderError (InvalidConfigError e) = V.invalidConfigError e+renderError (CacheError e) = V.fingerprintError 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+ formatter <- resultFormatter+ liftIO $ V.searchResults formatter $ groupedResponses grouping filters++loadAllConfigs :: App [LanguageConfiguration]+loadAllConfigs = do+ configs <- liftIO (B.first InvalidConfigError <$> loadAllConfigurations)+ either throwError return configs++calculateTagInput :: App [String]+calculateTagInput = do+ tags <- liftIO . fmap (B.first TagError) . loadTags =<< readFromStdIn+ either throwError return tags+ where+ loadTags b = if b then loadTagsFromPipe else loadTagsFromFile++withCache :: IO SearchResults -> App SearchResults+withCache f =+ operateCache =<< runWithCache+ where+ operateCache b = if b then withCache' f else liftIO f+ withCache' :: IO SearchResults -> App SearchResults+ withCache' r =+ either (throwError . CacheError) (return . SearchResults) =<<+ liftIO (cached "term-matches" $ fmap fromResults r)+++optionFilters :: AppConfig m => TermMatchSet -> m TermMatchSet+optionFilters tms = foldl (>>=) (pure tms) matchSetFilters+ where+ matchSetFilters =+ [ singleOccurrenceFilter+ , likelihoodsFilter+ , ignoredPathsFilter+ ]++singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet+singleOccurrenceFilter tms = do+ allowsSingleOccurrence <- oSingleOccurrenceMatches <$> ask+ return $ if allowsSingleOccurrence+ then withOneOccurrence tms+ else tms++likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet+likelihoodsFilter tms =+ withLikelihoods . likelihoods <$> ask <*> pure tms+ where+ likelihoods options+ | oAllLikelihoods options = [High, Medium, Low]+ | null $ oLikelihoods options = [High]+ | otherwise = oLikelihoods options++ignoredPathsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet+ignoredPathsFilter tms = ignoringPaths . oIgnoredPaths <$> ask <*> pure tms++readFromStdIn :: AppConfig m => m Bool+readFromStdIn = oFromStdIn <$> ask++groupingOptions :: AppConfig m => m CurrentGrouping+groupingOptions = oGrouping <$> ask++searchRunner :: AppConfig m => m SearchRunner+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
+ app/Main.hs view
@@ -0,0 +1,117 @@+module Main where++import App+import Options.Applicative+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++parseCLI :: IO Options+parseCLI =+ execParser (withInfo parseOptions pHeader pDescription pFooter)+ where+ pHeader = "Unused: Analyze potentially unused code"+ pDescription = "Unused allows a developer to leverage an existing tags file\+ \ (located at .git/tags, tags, or tmp/tags) to identify tokens\+ \ in a codebase that are unused."+ pFooter = "CLI USAGE: $ unused"++withInfo :: Parser a -> String -> String -> String -> ParserInfo a+withInfo opts h d f =+ info (helper <*> opts) $ header h <> progDesc d <> footer f++parseOptions :: Parser Options+parseOptions =+ Options+ <$> parseSearchRunner+ <*> parseDisplaySingleOccurrenceMatches+ <*> parseLikelihoods+ <*> parseAllLikelihoods+ <*> parseIgnorePaths+ <*> parseGroupings+ <*> parseWithoutCache+ <*> parseFromStdIn+ <*> parseCommitCount++parseSearchRunner :: Parser SearchRunner+parseSearchRunner =+ flag SearchWithProgress SearchWithoutProgress $+ short 'P'+ <> long "no-progress"+ <> help "Don't display progress during analysis"++parseDisplaySingleOccurrenceMatches :: Parser Bool+parseDisplaySingleOccurrenceMatches = switch $+ short 's'+ <> long "single-occurrence"+ <> help "Display only single occurrences"++parseLikelihoods :: Parser [RemovalLikelihood]+parseLikelihoods = many (parseLikelihood <$> parseLikelihoodOption)++parseLikelihood :: String -> RemovalLikelihood+parseLikelihood "high" = High+parseLikelihood "medium" = Medium+parseLikelihood "low" = Low+parseLikelihood _ = Unknown++parseLikelihoodOption :: Parser String+parseLikelihoodOption = strOption $+ short 'l'+ <> long "likelihood"+ <> help "[Allows multiple] [Allowed: high, medium, low] Display results based on likelihood"++parseAllLikelihoods :: Parser Bool+parseAllLikelihoods = switch $+ short 'a'+ <> long "all-likelihoods"+ <> help "Display all likelihoods"++parseIgnorePaths :: Parser [String]+parseIgnorePaths = many $ strOption $+ long "ignore"+ <> metavar "PATH"+ <> help "[Allows multiple] Ignore paths that contain PATH"++parseGroupings :: Parser CurrentGrouping+parseGroupings =+ fromMaybe GroupByDirectory <$> maybeGroup+ where+ maybeGroup = optional $ parseGrouping <$> parseGroupingOption++parseGrouping :: String -> CurrentGrouping+parseGrouping "directory" = GroupByDirectory+parseGrouping "term" = GroupByTerm+parseGrouping "file" = GroupByFile+parseGrouping "none" = NoGroup+parseGrouping _ = NoGroup++parseGroupingOption :: Parser String+parseGroupingOption = strOption $+ short 'g'+ <> long "group-by"+ <> help "[Allowed: directory, term, file, none] Group results"++parseWithoutCache :: Parser Bool+parseWithoutCache = switch $+ short 'C'+ <> long "no-cache"+ <> help "Ignore cache when performing calculations"++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"
+ data/config.yml view
@@ -0,0 +1,84 @@+- name: Rails+ aliases:+ - from: "%s?"+ to: "be_%s"+ - from: "has_%s?"+ to: "have_%s"+ allowedTerms:+ # serialization+ - as_json+ # inflection+ - Inflector+ # Concerns+ - ClassMethods+ - class_methods+ - included+ # rendering+ - to_partial_path+ autoLowLikelihood:+ - name: Migration+ pathStartsWith: db/migrate/+ classOrModule: true+ appOccurrences: 1+ - name: Migration Helper+ pathStartsWith: db/migrate/+ allowedTerms:+ - up+ - down+ - change+ - index+ - name: i18n+ allowedTerms:+ - t+ - l+ pathEndsWith: .rb+ - name: Controller+ pathStartsWith: app/controllers+ termEndsWith: Controller+ classOrModule: true+ - name: Helper+ pathStartsWith: app/helpers+ termEndsWith: Helper+ classOrModule: true+- name: Phoenix+ allowedTerms:+ - Mixfile+ - __using__+ autoLowLikelihood:+ - name: Migration+ pathStartsWith: priv/repo/migrations+ classOrModule: true+ - name: View+ pathStartsWith: web/views/+ termEndsWith: View+ classOrModule: true+ - name: Test+ pathStartsWith: test/+ termEndsWith: Test+ classOrModule: true+ - name: Controller actions+ pathStartsWith: web/controllers+ allowedTerms:+ - index+ - new+ - create+ - show+ - edit+ - update+ - destroy+- name: Haskell+ allowedTerms: []+ autoLowLikelihood:+ - name: Spec+ pathStartsWith: test/+ termEndsWith: Spec+ classOrModule: true+ - name: Cabalfile+ pathEndsWith: .cabal+ appOccurrences: 1+ - name: TypeClasses+ termEquals: instance+ pathEndsWith: .hs+ - name: Spec functions+ termEquals: spec+ pathStartsWith: test/
+ src/Unused/Aliases.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Unused.Aliases+ ( groupedTermsAndAliases+ , termsAndAliases+ ) where++import Data.Tuple (swap)+import Data.List (nub, sort, find, (\\))+import Data.Text (Text)+import qualified Data.Text as T+import Unused.ResultsClassifier.Types+import Unused.Types (TermMatch, tmTerm)+import Unused.Util (groupBy)++type Alias = (Text, Text)+type GroupedResult = (String, [TermMatch])++groupedTermsAndAliases :: [TermAlias] -> [TermMatch] -> [[TermMatch]]+groupedTermsAndAliases as ms =+ map snd $ foldl (processResultsWithAliases aliases) [] matchesGroupedByTerm+ where+ matchesGroupedByTerm = groupBy tmTerm ms+ aliases = map toAlias as++termsAndAliases :: [TermAlias] -> [String] -> [String]+termsAndAliases [] = id+termsAndAliases as =+ nub . map T.unpack . concatMap (allAliases aliases . T.pack)+ where+ aliases = map toAlias as+ allAliases :: [Alias] -> Text -> [Text]+ allAliases as' term = concatMap (`generateAliases` term) as'++processResultsWithAliases :: [Alias] -> [GroupedResult] -> GroupedResult -> [GroupedResult]+processResultsWithAliases as acc result@(term, matches) =+ if noAliasesExist+ then acc ++ [result]+ else case closestAlias of+ Nothing -> acc ++ [result]+ Just alias@(aliasTerm, aliasMatches) -> (acc \\ [alias]) ++ [(aliasTerm, aliasMatches ++ matches)]+ where+ packedTerm = T.pack term+ noAliasesExist = null listOfAliases+ listOfAliases = nub (concatMap (`aliasesForTerm` packedTerm) as) \\ [packedTerm]+ closestAlias = find ((`elem` listOfAliases) . T.pack . fst) acc++toAlias :: TermAlias -> Alias+toAlias TermAlias{taFrom = from, taTo = to} = (T.pack from, T.pack to)++generateAliases :: Alias -> Text -> [Text]+generateAliases (from, to) term =+ toTermWithAlias $ parsePatternForMatch from term+ where+ toTermWithAlias (Right (Just match)) = [term, T.replace wildcard match to]+ toTermWithAlias _ = [term]++parsePatternForMatch :: Text -> Text -> Either Text (Maybe Text)+parsePatternForMatch aliasPattern term =+ findMatch $ T.splitOn wildcard aliasPattern+ where+ findMatch [prefix, suffix] = Right $ T.stripSuffix suffix =<< T.stripPrefix prefix term+ findMatch _ = Left $ T.pack $ "There was a problem with the pattern: " ++ show aliasPattern++aliasesForTerm :: Alias -> Text -> [Text]+aliasesForTerm a t = nub $ sort $ generateAliases a t ++ generateAliases (swap a) t++wildcard :: Text+wildcard = "%s"
+ src/Unused/CLI.hs view
@@ -0,0 +1,7 @@+module Unused.CLI+ ( module X+ ) where++import Unused.CLI.Search as X+import Unused.CLI.GitContext as X+import Unused.CLI.Util as X
+ src/Unused/CLI/GitContext.hs view
@@ -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
+ src/Unused/CLI/ProgressIndicator.hs view
@@ -0,0 +1,30 @@+module Unused.CLI.ProgressIndicator+ ( ProgressIndicator+ , createProgressBar+ , createSpinner+ , progressWithIndicator+ ) where++import Control.Concurrent.ParallelIO+import Unused.CLI.Util+import Unused.CLI.ProgressIndicator.Types+import Unused.CLI.ProgressIndicator.Internal++createProgressBar :: ProgressIndicator+createProgressBar = ProgressBar Nothing Nothing++createSpinner :: ProgressIndicator+createSpinner =+ Spinner snapshots (length snapshots) 75000 colors Nothing+ where+ snapshots = ["⣾", "⣽", "⣻", "⢿", "⡿", "⣟", "⣯", "⣷"]+ colors = cycle [Black, Red, Yellow, Green, Blue, Cyan, Magenta]++progressWithIndicator :: Monoid b => (a -> IO b) -> ProgressIndicator -> [a] -> IO b+progressWithIndicator f i terms = do+ printPrefix i+ (tid, indicator) <- start i $ length terms+ installChildInterruptHandler tid+ mconcat <$> parallel (ioOps indicator) <* stop indicator+ where+ ioOps i' = map (\t -> f t <* increment i') terms
+ src/Unused/CLI/ProgressIndicator/Internal.hs view
@@ -0,0 +1,53 @@+module Unused.CLI.ProgressIndicator.Internal+ ( start+ , stop+ , increment+ , printPrefix+ ) where++import Control.Monad (forever)+import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)+import System.ProgressBar (ProgressRef, startProgress, incProgress, msg, percentage)+import Unused.CLI.ProgressIndicator.Types+import Unused.CLI.Util++start :: ProgressIndicator -> Int -> IO (ThreadId, ProgressIndicator)+start s@Spinner{} _ = do+ tid <- forkIO $ runSpinner 0 s+ return (tid, s { sThreadId = Just tid })+start ProgressBar{} i = do+ (ref, tid) <- buildProgressBar $ toInteger i+ return (tid, ProgressBar (Just ref) (Just tid))++stop :: ProgressIndicator -> IO ()+stop ProgressBar{ pbThreadId = Just tid } = killThread tid+stop Spinner{ sThreadId = Just tid } = killThread tid+stop _ = return ()++increment :: ProgressIndicator -> IO ()+increment ProgressBar{ pbProgressRef = Just ref } = incProgress ref 1+increment _ = return ()++printPrefix :: ProgressIndicator -> IO ()+printPrefix ProgressBar{} = putStr "\n\n"+printPrefix Spinner{} = putStr " "++runSpinner :: Int -> ProgressIndicator -> IO ()+runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = forever $ do+ setSGR [SetColor Foreground Dull currentColor]+ putStr currentSnapshot+ cursorBackward 1+ threadDelay delay+ runSpinner (i + 1) s+ where+ currentSnapshot = snapshots !! (i `mod` snapshotLength)+ currentColor = colors !! (i `div` snapshotLength)+ snapshotLength = length'+runSpinner _ _ = return ()++buildProgressBar :: Integer -> IO (ProgressRef, ThreadId)+buildProgressBar =+ startProgress (msg message) percentage progressBarWidth+ where+ message = "Working"+ progressBarWidth = 60
+ src/Unused/CLI/ProgressIndicator/Types.hs view
@@ -0,0 +1,20 @@+module Unused.CLI.ProgressIndicator.Types+ ( ProgressIndicator(..)+ ) where++import Control.Concurrent (ThreadId)+import System.ProgressBar (ProgressRef)+import System.Console.ANSI (Color)++data ProgressIndicator+ = Spinner+ { sSnapshots :: [String]+ , sLength :: Int+ , sDelay :: Int+ , sColors :: [Color]+ , sThreadId :: Maybe ThreadId+ }+ | ProgressBar+ { pbProgressRef :: Maybe ProgressRef+ , pbThreadId :: Maybe ThreadId+ }
+ src/Unused/CLI/Search.hs view
@@ -0,0 +1,26 @@+module Unused.CLI.Search+ ( SearchRunner(..)+ , renderHeader+ , executeSearch+ ) where++import Unused.TermSearch (SearchResults, search)+import Unused.CLI.Util+import qualified Unused.CLI.Views as V+import Unused.CLI.ProgressIndicator++data SearchRunner = SearchWithProgress | SearchWithoutProgress++renderHeader :: [String] -> IO ()+renderHeader terms = do+ resetScreen+ V.analysisHeader terms++executeSearch :: SearchRunner -> [String] -> IO SearchResults+executeSearch runner terms = do+ renderHeader terms+ runSearch runner terms <* resetScreen++runSearch :: SearchRunner -> [String] -> IO SearchResults+runSearch SearchWithProgress = progressWithIndicator search createProgressBar+runSearch SearchWithoutProgress = progressWithIndicator search createSpinner
+ src/Unused/CLI/Util.hs view
@@ -0,0 +1,65 @@+module Unused.CLI.Util+ ( resetScreen+ , withRuntime+ , installChildInterruptHandler+ , module System.Console.ANSI+ ) where++import Control.Concurrent.ParallelIO+import Control.Monad (void)+import System.Console.ANSI+import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)+import Control.Exception (throwTo)+import System.Posix.Signals (Handler(Catch), installHandler, keyboardSignal)+import Control.Concurrent (ThreadId, myThreadId, killThread)+import System.Exit (ExitCode(ExitFailure))++withRuntime :: IO a -> IO a+withRuntime a = do+ hSetBuffering stdout NoBuffering+ withInterruptHandler $ withoutCursor a <* stopGlobalPool++resetScreen :: IO ()+resetScreen = do+ clearScreen+ setCursorPosition 0 0++withoutCursor :: IO a -> IO a+withoutCursor body = do+ hideCursor+ body <* showCursor++withInterruptHandler :: IO a -> IO a+withInterruptHandler body = do+ tid <- myThreadId+ void $ installHandler keyboardSignal (Catch (handleInterrupt tid)) Nothing+ body++installChildInterruptHandler :: ThreadId -> IO ()+installChildInterruptHandler tid = do+ currentThread <- myThreadId+ void $ installHandler keyboardSignal (Catch (handleChildInterrupt currentThread tid)) Nothing++handleInterrupt :: ThreadId -> IO ()+handleInterrupt tid = do+ resetScreenState+ throwTo tid $ ExitFailure interruptExitCode++handleChildInterrupt :: ThreadId -> ThreadId -> IO ()+handleChildInterrupt parentTid childTid = do+ killThread childTid+ resetScreenState+ throwTo parentTid $ ExitFailure interruptExitCode+ handleInterrupt parentTid++interruptExitCode :: Int+interruptExitCode =+ signalToInt $ 128 + keyboardSignal+ where+ signalToInt s = read $ show s :: Int++resetScreenState :: IO ()+resetScreenState = do+ resetScreen+ showCursor+ setSGR [Reset]
+ src/Unused/CLI/Views.hs view
@@ -0,0 +1,11 @@+module Unused.CLI.Views+ ( module X+ ) where++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.FingerprintError as X+import Unused.CLI.Views.SearchResult as X
+ src/Unused/CLI/Views/AnalysisHeader.hs view
@@ -0,0 +1,18 @@+module Unused.CLI.Views.AnalysisHeader+ ( analysisHeader+ ) where++import Unused.CLI.Util++analysisHeader :: [String] -> IO ()+analysisHeader terms = do+ setSGR [SetConsoleIntensity BoldIntensity]+ putStr "Unused: "+ setSGR [Reset]++ putStr "analyzing "++ setSGR [SetColor Foreground Dull Green]+ putStr $ show $ length terms+ setSGR [Reset]+ putStr " terms"
+ src/Unused/CLI/Views/Error.hs view
@@ -0,0 +1,15 @@+module Unused.CLI.Views.Error+ ( errorHeader+ ) where++import Unused.CLI.Util++errorHeader :: String -> IO ()+errorHeader s = do+ setSGR [SetColor Background Vivid Red]+ setSGR [SetColor Foreground Vivid White]+ setSGR [SetConsoleIntensity BoldIntensity]++ putStrLn $ "\n" ++ s ++ "\n"++ setSGR [Reset]
+ src/Unused/CLI/Views/FingerprintError.hs view
@@ -0,0 +1,19 @@+module Unused.CLI.Views.FingerprintError+ ( fingerprintError+ ) where++import Data.List (intercalate)+import Unused.Cache.DirectoryFingerprint+import Unused.CLI.Views.Error++fingerprintError :: FingerprintOutcome -> IO ()+fingerprintError e = do+ errorHeader "There was a problem generating a cache fingerprint:"++ printOutcomeMessage e++printOutcomeMessage :: FingerprintOutcome -> IO ()+printOutcomeMessage (MD5ExecutableNotFound execs) =+ putStrLn $+ "Unable to find any of the following executables \+ \in your PATH: " ++ intercalate ", " execs
+ src/Unused/CLI/Views/GitSHAsHeader.hs view
@@ -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"
+ src/Unused/CLI/Views/InvalidConfigError.hs view
@@ -0,0 +1,22 @@+module Unused.CLI.Views.InvalidConfigError+ ( invalidConfigError+ ) where++import Unused.CLI.Util+import Unused.CLI.Views.Error+import Unused.ResultsClassifier (ParseConfigError(..))++invalidConfigError :: [ParseConfigError] -> IO ()+invalidConfigError es = do+ errorHeader "There was a problem with the following config file(s):"++ mapM_ configError es++ setSGR [Reset]++configError :: ParseConfigError -> IO ()+configError ParseConfigError{ pcePath = path, pceParseError = msg} = do+ setSGR [SetConsoleIntensity BoldIntensity]+ putStrLn path+ setSGR [Reset]+ putStrLn $ " " ++ msg
+ src/Unused/CLI/Views/MissingTagsFileError.hs view
@@ -0,0 +1,42 @@+module Unused.CLI.Views.MissingTagsFileError+ ( missingTagsFileError+ ) where++import Unused.TagsSource+import Unused.CLI.Util+import Unused.CLI.Views.Error++missingTagsFileError :: TagSearchOutcome -> IO ()+missingTagsFileError e = do+ errorHeader "There was a problem finding a tags file."+ printOutcomeMessage e++ putStr "\n"++ setSGR [SetConsoleIntensity BoldIntensity]+ putStr "If you're generating a ctags file to a custom location, "+ putStrLn "you can pipe it into unused:"+ setSGR [Reset]++ putStrLn " cat custom/ctags | unused --stdin"++ putStr "\n"++ setSGR [SetConsoleIntensity BoldIntensity]+ putStrLn "You can find out more about Exuberant Ctags here:"+ setSGR [Reset]+ putStrLn " http://ctags.sourceforge.net/"++ putStr "\n"++ setSGR [SetConsoleIntensity BoldIntensity]+ putStrLn "You can read about a good git-based Ctags workflow here:"+ setSGR [Reset]+ putStrLn " http://tbaggery.com/2011/08/08/effortless-ctags-with-git.html"++ putStr "\n"++printOutcomeMessage :: TagSearchOutcome -> IO ()+printOutcomeMessage (TagsFileNotFound directoriesSearched) = do+ putStrLn "Looked for a 'tags' file in the following directories:\n"+ mapM_ (\d -> putStrLn $ "* " ++ d) directoriesSearched
+ src/Unused/CLI/Views/NoResultsFound.hs view
@@ -0,0 +1,12 @@+module Unused.CLI.Views.NoResultsFound+ ( noResultsFound+ ) where++import Unused.CLI.Util++noResultsFound :: IO ()+noResultsFound = do+ setSGR [SetColor Foreground Dull Green]+ setSGR [SetConsoleIntensity BoldIntensity]+ putStrLn "Unused found no results"+ setSGR [Reset]
+ src/Unused/CLI/Views/SearchResult.hs view
@@ -0,0 +1,57 @@+module Unused.CLI.Views.SearchResult+ ( ResultsFormat(..)+ , searchResults+ ) where++import Control.Arrow ((&&&))+import qualified Data.Map.Strict as Map+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++searchResults :: ResultsFormat -> [GroupedTerms] -> IO ()+searchResults format terms = do+ resetScreen+ runReaderT (printFormattedTerms terms) resultsOptions+ where+ columnFormatter = buildColumnFormatter $ termsToResults terms+ resultsOptions = ResultsOptions columnFormatter format+ termsToResults = concatMap (Map.elems . snd)++printFormattedTerms :: [GroupedTerms] -> ResultsPrinter ()+printFormattedTerms [] = liftIO V.noResultsFound+printFormattedTerms ts = mapM_ printGroupingSection ts++listFromMatchSet :: TermMatchSet -> [(String, TermResults)]+listFromMatchSet =+ Map.toList++printGroupingSection :: GroupedTerms -> ResultsPrinter ()+printGroupingSection (g, tms) = do+ liftIO $ printGrouping g+ mapM_ printTermResults $ listFromMatchSet tms++printGrouping :: Grouping -> IO ()+printGrouping NoGrouping = return ()+printGrouping g = do+ putStr "\n"+ setSGR [SetColor Foreground Vivid Black]+ setSGR [SetConsoleIntensity BoldIntensity]+ print g+ setSGR [Reset]++printTermResults :: (String, TermResults) -> ResultsPrinter ()+printTermResults =+ uncurry printMatches . (id &&& trMatches) . snd++printMatches :: TermResults -> [TermMatch] -> ResultsPrinter ()+printMatches r ms = do+ outputFormat' <- outputFormat+ case outputFormat' of+ Column -> V.printTable r ms+ List -> V.printList r ms
+ src/Unused/CLI/Views/SearchResult/ColumnFormatter.hs view
@@ -0,0 +1,45 @@+module Unused.CLI.Views.SearchResult.ColumnFormatter+ ( ColumnFormat(..)+ , buildColumnFormatter+ ) where++import Text.Printf+import Unused.Types (TermResults(..), TermMatch(..), totalFileCount, totalOccurrenceCount)++data ColumnFormat = ColumnFormat+ { cfPrintTerm :: String -> String+ , cfPrintPath :: String -> String+ , cfPrintNumber :: Int -> String+ }++buildColumnFormatter :: [TermResults] -> ColumnFormat+buildColumnFormatter r =+ ColumnFormat (printf $ termFormat r) (printf $ pathFormat r) (printf $ numberFormat r)++termFormat :: [TermResults] -> String+termFormat rs =+ "%-" ++ show termWidth ++ "s"+ where+ termWidth = maximum $ termLength =<< trMatches =<< rs+ termLength = return . length . tmTerm++pathFormat :: [TermResults] -> String+pathFormat rs =+ "%-" ++ show pathWidth ++ "s"+ where+ pathWidth = maximum $ pathLength =<< trMatches =<< rs+ pathLength = return . length . tmPath++numberFormat :: [TermResults] -> String+numberFormat rs =+ "%" ++ show numberWidth ++ "d"+ where+ numberWidth = maximum [fileWidth, occurrenceWidth]+ fileWidth = maximum $ fileLength =<< rs+ occurrenceWidth = maximum $ occurrenceLength =<< rs+ fileLength = return . numberLength . totalFileCount+ occurrenceLength = return . numberLength . totalOccurrenceCount++numberLength :: Int -> Int+numberLength i =+ 1 + floor (logBase 10 $ fromIntegral i :: Double)
+ src/Unused/CLI/Views/SearchResult/Internal.hs view
@@ -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
+ src/Unused/CLI/Views/SearchResult/ListResult.hs view
@@ -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
+ src/Unused/CLI/Views/SearchResult/TableResult.hs view
@@ -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"
+ src/Unused/CLI/Views/SearchResult/Types.hs view
@@ -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
+ src/Unused/Cache.hs view
@@ -0,0 +1,50 @@+module Unused.Cache+ ( FingerprintOutcome(..)+ , cached+ ) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader+import System.Directory+import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)+import Data.Vector (toList)+import qualified Data.ByteString.Lazy as BS+import Unused.Cache.DirectoryFingerprint++newtype CacheFileName = CacheFileName String+type Cache = ReaderT CacheFileName IO++cached :: (FromRecord a, ToRecord a) => String -> IO [a] -> IO (Either FingerprintOutcome [a])+cached cachePrefix f =+ mapM fromCache =<< cacheFileName cachePrefix+ where+ fromCache = runReaderT $ maybe (writeCache =<< liftIO f) return =<< readCache++writeCache :: ToRecord a => [a] -> Cache [a]+writeCache [] = return []+writeCache contents = do+ liftIO $ createDirectoryIfMissing True cacheDirectory+ (CacheFileName fileName) <- ask+ liftIO $ BS.writeFile fileName $ encode contents+ return contents++readCache :: FromRecord a => Cache (Maybe [a])+readCache = do+ (CacheFileName fileName) <- ask+ exists <- liftIO $ doesFileExist fileName++ if exists+ then fmap processCsv (decode NoHeader <$> liftIO (BS.readFile fileName))+ else return Nothing+ where+ processCsv = either (const Nothing) (Just . toList)++cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName)+cacheFileName context = do+ putStrLn "\n\nCalculating cache fingerprint... "+ fmap toFileName <$> sha+ where+ toFileName s = CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"++cacheDirectory :: String+cacheDirectory = "tmp/unused"
+ src/Unused/Cache/DirectoryFingerprint.hs view
@@ -0,0 +1,53 @@+module Unused.Cache.DirectoryFingerprint+ ( FingerprintOutcome(..)+ , sha+ ) where++import System.Process+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader+import qualified System.Directory as D+import qualified Data.Char as C+import Data.Maybe (fromMaybe)+import Unused.Cache.FindArgsFromIgnoredPaths+import Unused.Util (safeHead, readIfFileExists)++type MD5Config = ReaderT String IO++data FingerprintOutcome+ = MD5ExecutableNotFound [String]++sha :: IO (Either FingerprintOutcome String)+sha = do+ md5Executable' <- md5Executable+ case md5Executable' of+ Just exec ->+ Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) exec+ Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables+ where+ getSha = takeWhile C.isAlphaNum . fromMaybe "" . safeHead . lines++fileList :: MD5Config String+fileList = do+ filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths+ md5exec <- ask+ let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]+ liftIO $ readProcess "find" args ""++sortInput :: String -> MD5Config String+sortInput = liftIO . readProcess "sort" ["-k", "2"]++md5Result :: String -> MD5Config String+md5Result r = do+ md5exec <- ask+ liftIO $ readProcess md5exec [] r++ignoredPaths :: IO [String]+ignoredPaths = fromMaybe [] <$> (fmap lines <$> readIfFileExists ".gitignore")++md5Executable :: IO (Maybe String)+md5Executable =+ safeHead . concat <$> mapM D.findExecutables supportedMD5Executables++supportedMD5Executables :: [String]+supportedMD5Executables = ["md5", "md5sum"]
+ src/Unused/Cache/FindArgsFromIgnoredPaths.hs view
@@ -0,0 +1,47 @@+module Unused.Cache.FindArgsFromIgnoredPaths+ ( findArgs+ ) where++import Data.Char (isAlphaNum)+import Data.List (isSuffixOf)+import System.FilePath++findArgs :: [String] -> [String]+findArgs = concatMap ignoreToFindArgs . validIgnoreOptions++wildcardPrefix :: String -> String+wildcardPrefix a@('*':'/':_) = a+wildcardPrefix ('*':s) = "*/" ++ s+wildcardPrefix ('/':s) = "*/" ++ s+wildcardPrefix a = "*/" ++ a++toExclusions :: String -> [String]+toExclusions s =+ case (isWildcardFilename s, isMissingFilename s) of+ (True, _) -> ["-not", "-path", s]+ (_, True) -> ["-not", "-path", wildcardSuffix s]+ (_, False) -> ["-not", "-name", s, "-not", "-path", wildcardSuffix s]++ignoreToFindArgs :: String -> [String]+ignoreToFindArgs = toExclusions . wildcardPrefix++wildcardSuffix :: String -> String+wildcardSuffix s+ | isWildcardFilename s = s+ | "/" `isSuffixOf` s = s ++ "*"+ | otherwise = s ++ "/*"++isWildcardFilename :: String -> Bool+isWildcardFilename = elem '*' . takeFileName++isMissingFilename :: String -> Bool+isMissingFilename s = takeFileName s == ""++validIgnoreOptions :: [String] -> [String]+validIgnoreOptions =+ filter isPath+ where+ isPath "" = False+ isPath ('/':_) = True+ isPath ('.':_) = True+ isPath s = isAlphaNum $ head s
+ src/Unused/GitContext.hs view
@@ -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
+ src/Unused/Grouping.hs view
@@ -0,0 +1,32 @@+module Unused.Grouping+ ( Grouping(..)+ , CurrentGrouping(..)+ , GroupedTerms+ , groupedResponses+ ) where++import qualified Data.Map.Strict as Map+import Data.List (sort, nub)+import Unused.Types+import Unused.ResponseFilter (updateMatches)+import Unused.Grouping.Types+import Unused.Grouping.Internal++groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms]+groupedResponses g tms =+ (\g' -> (g', groupedMatchSetSubsets currentGroup g' tms)) <$> groupingsFromSet+ where+ groupingsFromSet = allGroupings currentGroup tms+ currentGroup = groupFilter g++groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet+groupedMatchSetSubsets f tms =+ updateMatches newMatches+ where+ newMatches = filter ((== tms) . f)++allGroupings :: GroupFilter -> TermMatchSet -> [Grouping]+allGroupings f =+ uniqueValues . Map.map (fmap f . trMatches)+ where+ uniqueValues = sort . nub . concat . Map.elems
+ src/Unused/Grouping/Internal.hs view
@@ -0,0 +1,27 @@+module Unused.Grouping.Internal+ ( groupFilter+ ) where++import Unused.Grouping.Types+import System.FilePath (takeDirectory, splitDirectories)+import Unused.Types (tmPath, tmTerm)+import Data.List (intercalate)++groupFilter :: CurrentGrouping -> GroupFilter+groupFilter GroupByDirectory = fileNameGrouping+groupFilter GroupByTerm = termGrouping+groupFilter GroupByFile = fileGrouping+groupFilter NoGroup = const NoGrouping++fileNameGrouping :: GroupFilter+fileNameGrouping = ByDirectory . shortenedDirectory . tmPath++termGrouping :: GroupFilter+termGrouping = ByTerm . tmTerm++fileGrouping :: GroupFilter+fileGrouping = ByFile . tmPath++shortenedDirectory :: String -> String+shortenedDirectory =+ intercalate "/" . take 2 . splitDirectories . takeDirectory
+ src/Unused/Grouping/Types.hs view
@@ -0,0 +1,20 @@+module Unused.Grouping.Types+ ( Grouping(..)+ , CurrentGrouping(..)+ , GroupedTerms+ , GroupFilter+ ) where++import Unused.Types (TermMatchSet, TermMatch)++data Grouping = ByDirectory String | ByTerm String | ByFile String | NoGrouping deriving (Eq, Ord)+data CurrentGrouping = GroupByDirectory | GroupByTerm | GroupByFile | NoGroup++type GroupedTerms = (Grouping, TermMatchSet)+type GroupFilter = TermMatch -> Grouping++instance Show Grouping where+ show (ByDirectory s) = s+ show (ByTerm s) = s+ show (ByFile s) = s+ show NoGrouping = ""
+ src/Unused/LikelihoodCalculator.hs view
@@ -0,0 +1,46 @@+module Unused.LikelihoodCalculator+ ( calculateLikelihood+ , LanguageConfiguration+ ) where++import Data.Maybe (isJust)+import Data.List (find, intercalate)+import Unused.ResultsClassifier+import Unused.Types+import Unused.ResponseFilter (autoLowLikelihood)++calculateLikelihood :: [LanguageConfiguration] -> TermResults -> TermResults+calculateLikelihood lcs r =+ r { trRemoval = uncurry Removal newLikelihood }+ where+ baseScore = totalOccurrenceCount r+ totalScore = baseScore+ newLikelihood+ | isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)+ | singleNonTestUsage r && testsExist r = (High, "only the definition and corresponding tests exist")+ | doubleNonTestUsage r && testsExist r = (Medium, "only the definition and one other use, along with tests, exists")+ | totalScore < 2 = (High, "used once")+ | totalScore < 6 = (Medium, "used semi-frequently")+ | totalScore >= 6 = (Low, "used frequently")+ | otherwise = (Unknown, "could not determine likelihood")+ firstAutoLowLikelihood = find (`autoLowLikelihood` r) lcs+ autoLowLikelihoodMessage =+ case firstAutoLowLikelihood of+ Nothing -> ""+ Just lang -> languageConfirmationMessage lang++languageConfirmationMessage :: LanguageConfiguration -> String+languageConfirmationMessage lc =+ langFramework ++ ": allowed term or " ++ lowLikelihoodNames+ where+ langFramework = lcName lc+ lowLikelihoodNames = intercalate ", " $ map smName $ lcAutoLowLikelihood lc++singleNonTestUsage :: TermResults -> Bool+singleNonTestUsage = (1 ==) . oOccurrences . trAppOccurrences++doubleNonTestUsage :: TermResults -> Bool+doubleNonTestUsage = (2 ==) . oOccurrences . trAppOccurrences++testsExist :: TermResults -> Bool+testsExist = (> 0) . oOccurrences . trTestOccurrences
+ src/Unused/Parser.hs view
@@ -0,0 +1,26 @@+module Unused.Parser+ ( parseResults+ ) where++import Data.Bifunctor (second)+import Control.Arrow ((&&&))+import qualified Data.Map.Strict as Map+import Data.List (intercalate, sort, nub)+import Unused.TermSearch (SearchResults, fromResults)+import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmTerm)+import Unused.LikelihoodCalculator+import Unused.ResultsClassifier.Types+import Unused.Aliases++parseResults :: [LanguageConfiguration] -> SearchResults -> TermMatchSet+parseResults lcs =+ Map.fromList . map (second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults+ where+ aliases = concatMap lcTermAliases lcs++groupResults :: [TermAlias] -> [TermMatch] -> [(String, [TermMatch])]+groupResults aliases ms =+ map (toKey &&& id) groupedMatches+ where+ toKey = intercalate "|" . nub . sort . map tmTerm+ groupedMatches = groupedTermsAndAliases aliases ms
+ src/Unused/Regex.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleContexts #-}++module Unused.Regex+ ( matchRegex+ ) where++import Text.Regex.TDFA++matchRegex :: String -> String -> Bool+matchRegex = matchTest . stringToRegex++stringToRegex :: RegexMaker Regex CompOption ExecOption String => String -> Regex+stringToRegex = makeRegex
+ src/Unused/ResponseFilter.hs view
@@ -0,0 +1,82 @@+module Unused.ResponseFilter+ ( withOneOccurrence+ , withLikelihoods+ , oneOccurence+ , ignoringPaths+ , isClassOrModule+ , autoLowLikelihood+ , updateMatches+ ) where++import qualified Data.Map.Strict as Map+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)+import qualified Data.Char as C+import Unused.Types+import Unused.ResultsClassifier++withOneOccurrence :: TermMatchSet -> TermMatchSet+withOneOccurrence = Map.filterWithKey (const oneOccurence)++oneOccurence :: TermResults -> Bool+oneOccurence = (== 1) . totalOccurrenceCount++withLikelihoods :: [RemovalLikelihood] -> TermMatchSet -> TermMatchSet+withLikelihoods [] = id+withLikelihoods l = Map.filterWithKey (const $ includesLikelihood l)++ignoringPaths :: [String] -> TermMatchSet -> TermMatchSet+ignoringPaths xs =+ updateMatches newMatches+ where+ newMatches = filter (not . matchesPath . tmPath)+ matchesPath p = any (`isInfixOf` p) xs++includesLikelihood :: [RemovalLikelihood] -> TermResults -> Bool+includesLikelihood l = (`elem` l) . rLikelihood . trRemoval++isClassOrModule :: TermResults -> Bool+isClassOrModule =+ startsWithUpper . trTerm+ where+ startsWithUpper [] = False+ startsWithUpper (a:_) = C.isUpper a++autoLowLikelihood :: LanguageConfiguration -> TermResults -> Bool+autoLowLikelihood l r =+ isAllowedTerm r allowedTerms || or anySinglesOkay+ where+ allowedTerms = lcAllowedTerms l+ anySinglesOkay = map (\sm -> classOrModule sm r && matchesToBool (smMatchers sm)) singles+ singles = lcAutoLowLikelihood l+ classOrModule = classOrModuleFunction . smClassOrModule++ matchesToBool :: [Matcher] -> Bool+ matchesToBool [] = False+ matchesToBool a = all (`matcherToBool` r) a++classOrModuleFunction :: Bool -> TermResults -> Bool+classOrModuleFunction True = isClassOrModule+classOrModuleFunction False = const True++matcherToBool :: Matcher -> TermResults -> Bool+matcherToBool (Path p v) = any (positionToTest p v) . paths+matcherToBool (Term p v) = positionToTest p v . trTerm+matcherToBool (AppOccurrences i) = (== i) . appOccurrenceCount+matcherToBool (AllowedTerms ts) = (`isAllowedTerm` ts)++positionToTest :: Position -> (String -> String -> Bool)+positionToTest StartsWith = isPrefixOf+positionToTest EndsWith = isSuffixOf+positionToTest Equals = (==)++paths :: TermResults -> [String]+paths r = tmPath <$> trMatches r++updateMatches :: ([TermMatch] -> [TermMatch]) -> TermMatchSet -> TermMatchSet+updateMatches fm =+ Map.map (updateMatchesWith $ fm . trMatches)+ where+ updateMatchesWith f tr = tr { trMatches = f tr }++isAllowedTerm :: TermResults -> [String] -> Bool+isAllowedTerm = elem . trTerm
+ src/Unused/ResultsClassifier.hs view
@@ -0,0 +1,6 @@+module Unused.ResultsClassifier+ ( module X+ ) where++import Unused.ResultsClassifier.Types as X+import Unused.ResultsClassifier.Config as X
+ src/Unused/ResultsClassifier/Config.hs view
@@ -0,0 +1,45 @@+module Unused.ResultsClassifier.Config+ ( loadConfig+ , loadAllConfigurations+ ) where++import qualified Data.Yaml as Y+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C+import qualified Data.Either as E+import qualified Data.Bifunctor as B+import System.FilePath ((</>))+import System.Directory (getHomeDirectory)+import Paths_unused (getDataFileName)+import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))+import Unused.Util (readIfFileExists)++loadConfig :: IO (Either String [LanguageConfiguration])+loadConfig = Y.decodeEither <$> readConfig++loadAllConfigurations :: IO (Either [ParseConfigError] [LanguageConfiguration])+loadAllConfigurations = do+ homeDir <- getHomeDirectory++ defaultConfig <- addSourceToLeft "default config" <$> loadConfig+ localConfig <- loadConfigFromFile ".unused.yml"+ userConfig <- loadConfigFromFile $ homeDir </> ".unused.yml"++ let (lefts, rights) = E.partitionEithers [defaultConfig, localConfig, userConfig]++ if not (null lefts)+ then return $ Left lefts+ else return $ Right $ concat rights++loadConfigFromFile :: String -> IO (Either ParseConfigError [LanguageConfiguration])+loadConfigFromFile path = do+ file <- fmap C.pack <$> readIfFileExists path+ return $ case file of+ Nothing -> Right []+ Just body -> addSourceToLeft path $ Y.decodeEither body++addSourceToLeft :: String -> Either String c -> Either ParseConfigError c+addSourceToLeft source = B.first (ParseConfigError source)++readConfig :: IO BS.ByteString+readConfig = getDataFileName ("data" </> "config.yml") >>= BS.readFile
+ src/Unused/ResultsClassifier/Types.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}++module Unused.ResultsClassifier.Types+ ( LanguageConfiguration(..)+ , LowLikelihoodMatch(..)+ , TermAlias(..)+ , Position(..)+ , Matcher(..)+ , ParseConfigError(..)+ ) where++import Control.Monad (mzero)+import qualified Data.Text as T+import qualified Data.Yaml as Y+import qualified Data.List as L+import Data.HashMap.Strict (keys)+import Control.Applicative (Alternative, empty)+import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))++data LanguageConfiguration = LanguageConfiguration+ { lcName :: String+ , lcAllowedTerms :: [String]+ , lcAutoLowLikelihood :: [LowLikelihoodMatch]+ , lcTermAliases :: [TermAlias]+ } deriving Show++data LowLikelihoodMatch = LowLikelihoodMatch+ { smName :: String+ , smMatchers :: [Matcher]+ , smClassOrModule :: Bool+ } deriving Show++data TermAlias = TermAlias+ { taFrom :: String+ , taTo :: String+ } deriving Show++data ParseConfigError = ParseConfigError+ { pcePath :: String+ , pceParseError :: String+ }++data Position = StartsWith | EndsWith | Equals deriving Show+data Matcher = Term Position String | Path Position String | AppOccurrences Int | AllowedTerms [String] deriving Show++instance FromJSON LanguageConfiguration where+ parseJSON (Y.Object o) = LanguageConfiguration+ <$> o .: "name"+ <*> o .:? "allowedTerms" .!= []+ <*> o .:? "autoLowLikelihood" .!= []+ <*> o .:? "aliases" .!= []+ parseJSON _ = mzero++instance FromJSON LowLikelihoodMatch where+ parseJSON (Y.Object o) = LowLikelihoodMatch+ <$> o .: "name"+ <*> parseMatchers o+ <*> o .:? "classOrModule" .!= False+ parseJSON _ = mzero++instance FromJSON TermAlias where+ parseJSON (Y.Object o) = TermAlias+ <$> o .: "from"+ <*> o .: "to"+ parseJSON _ = mzero++data MatchHandler a = MatchHandler+ { mhKeys :: [String]+ , mhKeyToMatcher :: T.Text -> Either T.Text (a -> Matcher)+ }++intHandler :: MatchHandler Int+intHandler = MatchHandler+ { mhKeys = ["appOccurrences"]+ , mhKeyToMatcher = keyToMatcher+ }+ where+ keyToMatcher "appOccurrences" = Right AppOccurrences+ keyToMatcher t = Left t++stringHandler :: MatchHandler String+stringHandler = MatchHandler+ { mhKeys = ["pathStartsWith", "pathEndsWith", "termStartsWith", "termEndsWith", "termEquals"]+ , mhKeyToMatcher = keyToMatcher+ }+ where+ keyToMatcher "pathStartsWith" = Right $ Path StartsWith+ keyToMatcher "pathEndsWith" = Right $ Path EndsWith+ keyToMatcher "termStartsWith" = Right $ Term StartsWith+ keyToMatcher "termEndsWith" = Right $ Term EndsWith+ keyToMatcher "termEquals" = Right $ Term Equals+ keyToMatcher t = Left t++stringListHandler :: MatchHandler [String]+stringListHandler = MatchHandler+ { mhKeys = ["allowedTerms"]+ , mhKeyToMatcher = keyToMatcher+ }+ where+ keyToMatcher "allowedTerms" = Right AllowedTerms+ keyToMatcher t = Left t++lowLikelihoodMatchKeys :: [T.Text]+lowLikelihoodMatchKeys =+ map T.pack $ ["name", "classOrModule"] ++ mhKeys intHandler ++ mhKeys stringHandler ++ mhKeys stringListHandler++validateLowLikelihoodKeys :: Y.Object -> Y.Parser [Matcher] -> Y.Parser [Matcher]+validateLowLikelihoodKeys o ms =+ if fullOverlap+ then ms+ else fail $ "The following keys are unsupported: " ++ L.intercalate ", " (T.unpack <$> unsupportedKeys)+ where+ fullOverlap = null unsupportedKeys+ unsupportedKeys = keys o L.\\ lowLikelihoodMatchKeys++parseMatchers :: Y.Object -> Y.Parser [Matcher]+parseMatchers o =+ validateLowLikelihoodKeys o $ myFold (++) [buildMatcherList o intHandler, buildMatcherList o stringHandler, buildMatcherList o stringListHandler]+ where+ myFold :: (Foldable t, Monad m) => (a -> a -> a) -> t (m a) -> m a+ myFold f = foldl1 (\acc i -> acc >>= (\l -> f l <$> i))++buildMatcherList :: FromJSON a => Y.Object -> MatchHandler a -> Y.Parser [Matcher]+buildMatcherList o mh =+ sequenceA $ matcherParserForKey <$> keysToParse+ where+ matcherParserForKey k = extractMatcher (mhKeyToMatcher mh k) $ mKey k+ keysToParse = positionKeysforMatcher o (mhKeys mh)+ mKey = (.:?) o++positionKeysforMatcher :: Y.Object -> [String] -> [T.Text]+positionKeysforMatcher o ls = L.intersect (T.pack <$> ls) $ keys o++extractMatcher :: Either T.Text (a -> Matcher) -> Y.Parser (Maybe a) -> Y.Parser Matcher+extractMatcher e p = either displayFailure (convertFoundObjectToMatcher p) e++convertFoundObjectToMatcher :: (Monad m, Alternative m) => m (Maybe a) -> (a -> b) -> m b+convertFoundObjectToMatcher p f = maybe empty (pure . f) =<< p++displayFailure :: T.Text -> Y.Parser a+displayFailure t = fail $ "Parse error: '" ++ T.unpack t ++ "' is not a valid key in a singleOnly matcher"
+ src/Unused/TagsSource.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Unused.TagsSource+ ( TagSearchOutcome(..)+ , loadTagsFromFile+ , loadTagsFromPipe+ ) where++import Data.List (isPrefixOf, nub)+import System.Directory (findFile)+import qualified Data.Text as T++data TagSearchOutcome+ = TagsFileNotFound [String]++loadTagsFromPipe :: IO (Either TagSearchOutcome [String])+loadTagsFromPipe = fmap (Right . tokensFromTags) getContents++loadTagsFromFile :: IO (Either TagSearchOutcome [String])+loadTagsFromFile = fmap (fmap tokensFromTags) tagsContent++tokensFromTags :: String -> [String]+tokensFromTags =+ filter validTokens . nub . tokenLocations+ where+ tokenLocations = map (token . T.splitOn "\t" . T.pack) . lines+ token = T.unpack . head++validTokens :: String -> Bool+validTokens = not . isPrefixOf "!_TAG"++tagsContent :: IO (Either TagSearchOutcome String)+tagsContent = findFile possibleTagsFileDirectories "tags" >>= eitherReadFile++eitherReadFile :: Maybe String -> IO (Either TagSearchOutcome String)+eitherReadFile Nothing = return $ Left $ TagsFileNotFound possibleTagsFileDirectories+eitherReadFile (Just path) = Right <$> readFile path++possibleTagsFileDirectories :: [String]+possibleTagsFileDirectories = [".git", "tmp", "."]
+ src/Unused/TermSearch.hs view
@@ -0,0 +1,20 @@+module Unused.TermSearch+ ( SearchResults(..)+ , fromResults+ , search+ ) where++import System.Process+import Data.Maybe (mapMaybe)+import Unused.TermSearch.Types+import Unused.TermSearch.Internal++search :: String -> IO SearchResults+search t = do+ results <- lines <$> ag t+ return $ SearchResults $ mapMaybe (parseSearchResult t) results++ag :: String -> IO String+ag t = do+ (_, results, _) <- readProcessWithExitCode "ag" (commandLineOptions t) ""+ return results
+ src/Unused/TermSearch/Internal.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++module Unused.TermSearch.Internal+ ( commandLineOptions+ , parseSearchResult+ ) where++import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import qualified Data.Char as C+import Unused.Types (TermMatch(..))+import Unused.Util (stringToInt)++commandLineOptions :: String -> [String]+commandLineOptions t =+ if regexSafeTerm t+ then ["(\\W|^)" ++ t ++ "(\\W|$)", "."] ++ baseFlags+ else [t, ".", "-Q"] ++ baseFlags+ where+ baseFlags = ["-c", "--ackmate", "--ignore-dir", "tmp/unused"]++parseSearchResult :: String -> String -> Maybe TermMatch+parseSearchResult term s =+ toTermMatch $ map T.unpack $ T.splitOn ":" $ T.pack s+ where+ toTermMatch [_, path, count] = Just $ TermMatch term path (countInt count)+ toTermMatch _ = Nothing+ countInt = fromMaybe 0 . stringToInt++regexSafeTerm :: String -> Bool+regexSafeTerm =+ all regexSafeChar+ where+ regexSafeChar c = C.isAlphaNum c || c == '_' || c == '-'
+ src/Unused/TermSearch/Types.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Unused.TermSearch.Types+ ( SearchResults(..)+ , fromResults+ ) where++import Unused.Types (TermMatch)++newtype SearchResults = SearchResults [TermMatch] deriving (Monoid)++fromResults :: SearchResults -> [TermMatch]+fromResults (SearchResults a) = a
+ src/Unused/Types.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE DeriveGeneric #-}++module Unused.Types+ ( TermMatch(..)+ , TermResults(..)+ , TermMatchSet+ , RemovalLikelihood(..)+ , Removal(..)+ , Occurrences(..)+ , GitContext(..)+ , GitCommit(..)+ , resultsFromMatches+ , totalFileCount+ , totalOccurrenceCount+ , appOccurrenceCount+ , removalLikelihood+ , resultAliases+ ) where++import qualified Data.Map.Strict as Map+import Data.Csv+import qualified Data.List as L+import GHC.Generics+import Unused.Regex++data TermMatch = TermMatch+ { tmTerm :: String+ , tmPath :: String+ , tmOccurrences :: Int+ } deriving (Eq, Show, Generic)++instance FromRecord TermMatch+instance ToRecord TermMatch++data Occurrences = Occurrences+ { oFiles :: Int+ , oOccurrences :: Int+ } deriving (Eq, Show)++data TermResults = TermResults+ { trTerm :: String+ , trTerms :: [String]+ , trMatches :: [TermMatch]+ , trTestOccurrences :: Occurrences+ , trAppOccurrences :: Occurrences+ , trTotalOccurrences :: Occurrences+ , trRemoval :: Removal+ , trGitContext :: Maybe GitContext+ } deriving (Eq, Show)++data Removal = Removal+ { rLikelihood :: RemovalLikelihood+ , 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++totalFileCount :: TermResults -> Int+totalFileCount = oFiles . trTotalOccurrences++totalOccurrenceCount :: TermResults -> Int+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+ { trTerm = resultTerm terms+ , trTerms = L.sort $ L.nub terms+ , trMatches = m+ , trAppOccurrences = appOccurrence+ , 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+ appOccurrence = appOccurrences m+ terms = map tmTerm m+ resultTerm (x:_) = x+ resultTerm _ = ""++appOccurrences :: [TermMatch] -> Occurrences+appOccurrences ms =+ Occurrences appFiles appOccurrences'+ where+ totalFiles = length ms+ totalOccurrences = sum $ map tmOccurrences ms+ tests = testOccurrences ms+ appFiles = totalFiles - oFiles tests+ appOccurrences' = totalOccurrences - oOccurrences tests++testOccurrences :: [TermMatch] -> Occurrences+testOccurrences ms =+ Occurrences totalFiles totalOccurrences+ where+ testMatches = filter termMatchIsTest ms+ totalFiles = length testMatches+ totalOccurrences = sum $ map tmOccurrences testMatches++testDir :: String -> Bool+testDir = matchRegex "(spec|tests?|features)\\/"++testSnakeCaseFilename :: String -> Bool+testSnakeCaseFilename = matchRegex ".*(_spec|_test)\\."++testCamelCaseFilename :: String -> Bool+testCamelCaseFilename = matchRegex ".*(Spec|Test)\\."++termMatchIsTest :: TermMatch -> Bool+termMatchIsTest m =+ testDir path || testSnakeCaseFilename path || testCamelCaseFilename path+ where+ path = tmPath m
+ src/Unused/Util.hs view
@@ -0,0 +1,36 @@+module Unused.Util+ ( groupBy+ , stringToInt+ , safeHead+ , readIfFileExists+ ) where++import System.Directory (doesFileExist)+import Control.Arrow ((&&&))+import qualified Data.List as L+import Data.Function+import Data.Char (digitToInt, isDigit)++groupBy :: (Ord b) => (a -> b) -> [a] -> [(b, [a])]+groupBy f = map (f . head &&& id)+ . L.groupBy ((==) `on` f)+ . L.sortBy (compare `on` f)++safeHead :: [a] -> Maybe a+safeHead (x:_) = Just x+safeHead _ = Nothing++stringToInt :: String -> Maybe Int+stringToInt xs+ | all isDigit xs = Just $ loop 0 xs+ | otherwise = Nothing+ where+ loop = foldl (\acc x -> acc * 10 + digitToInt x)++readIfFileExists :: String -> IO (Maybe String)+readIfFileExists path = do+ exists <- doesFileExist path++ if exists+ then Just <$> readFile path+ else return Nothing
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Unused/AliasesSpec.hs view
@@ -0,0 +1,21 @@+module Unused.AliasesSpec where++import Test.Hspec+import Unused.Aliases+import Unused.ResultsClassifier.Types (TermAlias(..))++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $+ describe "termsAndAliases" $ do+ it "returns the terms if no aliases are provided" $+ termsAndAliases [] ["method_1", "method_2"] `shouldBe` ["method_1", "method_2"]++ it "adds aliases to the list of terms" $ do+ let predicateAlias = TermAlias "%s?" "be_%s"+ let pluralizeAlias = TermAlias "really_%s" "very_%s"++ termsAndAliases [predicateAlias, pluralizeAlias] ["awesome?", "really_cool"]+ `shouldBe` ["awesome?", "be_awesome", "really_cool", "very_cool"]
+ test/Unused/Cache/FindArgsFromIgnoredPathsSpec.hs view
@@ -0,0 +1,27 @@+module Unused.Cache.FindArgsFromIgnoredPathsSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Unused.Cache.FindArgsFromIgnoredPaths++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $+ describe "findArgs" $ do+ it "converts paths" $+ findArgs ["a/*", "/b/*", "c/"] `shouldBe` [ "-not", "-path", "*/a/*"+ , "-not", "-path", "*/b/*"+ , "-not", "-path", "*/c/*"]++ it "converts wildcards" $+ findArgs ["a/*.csv", "/b/*.csv"] `shouldBe` [ "-not", "-path", "*/a/*.csv"+ , "-not", "-path", "*/b/*.csv"]++ it "filenames and paths at the same time" $+ findArgs ["/.foreman", ".bundle/"] `shouldBe` [ "-not", "-name", "*/.foreman"+ , "-not", "-path", "*/.foreman/*"+ , "-not", "-path", "*/.bundle/*"]
+ test/Unused/Grouping/InternalSpec.hs view
@@ -0,0 +1,35 @@+module Unused.Grouping.InternalSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Unused.Types+import Unused.Grouping.Internal+import Unused.Grouping.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $+ describe "groupFilter" $ do+ it "groups by directory" $ do+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10++ groupFilter GroupByDirectory termMatch `shouldBe` ByDirectory "foo/bar"++ it "groups by term" $ do+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10++ groupFilter GroupByTerm termMatch `shouldBe` ByTerm "AwesomeClass"++ it "groups by file" $ do+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10++ groupFilter GroupByFile termMatch `shouldBe` ByFile "foo/bar/baz/buzz.rb"++ it "groups by nothing" $ do+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10++ groupFilter NoGroup termMatch `shouldBe` NoGrouping
+ test/Unused/LikelihoodCalculatorSpec.hs view
@@ -0,0 +1,62 @@+module Unused.LikelihoodCalculatorSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Unused.Types+import Unused.LikelihoodCalculator+import Unused.ResultsClassifier++main :: IO ()+main = hspec spec++spec :: Spec+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++ let elixirMatches = [ TermMatch "AwesomeView" "web/views/awesome_view.ex" 1 ]+ removalLikelihood' elixirMatches `shouldReturn` Low++ it "weighs widely-used methods as low likelihood" $ do+ let matches = [ TermMatch "full_name" "app/models/user.rb" 4+ , TermMatch "full_name" "app/views/application/_auth_header.rb" 1+ , TermMatch "full_name" "app/mailers/user_mailer.rb" 1+ , TermMatch "full_name" "spec/models/user_spec.rb" 10+ ]++ 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++ 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++ 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+ , TermMatch "obscure_method" "app/controllers/user_controller.rb" 1+ , TermMatch "obscure_method" "spec/models/user_spec.rb" 5+ , TermMatch "obscure_method" "spec/controllers/user_controller_spec.rb" 5+ ]++ 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' :: [TermMatch] -> IO RemovalLikelihood+removalLikelihood' ms = do+ (Right config) <- loadConfig+ return $ rLikelihood $ trRemoval $ calculateLikelihood config $ resultsFromMatches ms
+ test/Unused/ParserSpec.hs view
@@ -0,0 +1,65 @@+module Unused.ParserSpec where++import Test.Hspec+import Unused.Types+import Unused.Parser+import Unused.TermSearch+import Unused.ResultsClassifier+import qualified Data.Map.Strict as Map++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $+ describe "parseResults" $ do+ it "parses from the correct format" $ do+ let r1Matches = [ TermMatch "method_name" "app/path/foo.rb" 1+ , 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") 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") Nothing++ (Right config) <- loadConfig++ let result = parseResults config $ SearchResults $ r1Matches ++ r2Matches++ result `shouldBe`+ Map.fromList [ ("method_name", r1Results), ("other", r2Results) ]++ it "parses when no config is provided" $ do+ let r1Matches = [ TermMatch "method_name" "app/path/foo.rb" 1+ , 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") Nothing++ let result = parseResults [] $ SearchResults r1Matches++ result `shouldBe`+ Map.fromList [ ("method_name", r1Results) ]++ it "handles aliases correctly" $ do+ let r1Matches = [ TermMatch "admin?" "app/path/user.rb" 3 ]++ let r2Matches = [ TermMatch "be_admin" "spec/models/user_spec.rb" 2+ , TermMatch "be_admin" "spec/features/user_promoted_to_admin_spec.rb" 2+ ]+++ (Right config) <- loadConfig+ let searchResults = r1Matches ++ r2Matches++ 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") Nothing+ result `shouldBe`+ Map.fromList [ ("admin?|be_admin", results) ]++ it "handles empty input" $ do+ (Right config) <- loadConfig+ let result = parseResults config $ SearchResults []+ result `shouldBe` Map.fromList []
+ test/Unused/ResponseFilterSpec.hs view
@@ -0,0 +1,153 @@+module Unused.ResponseFilterSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Data.List (find)+import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)+import Unused.ResponseFilter+import Unused.ResultsClassifier++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+ describe "railsAutoLowLikelihood" $ do+ it "allows controllers" $ do+ let match = TermMatch "ApplicationController" "app/controllers/application_controller.rb" 1+ let result = resultsFromMatches [match]++ railsAutoLowLikelihood result `shouldReturn` True++ it "allows helpers" $ do+ let match = TermMatch "ApplicationHelper" "app/helpers/application_helper.rb" 1+ let result = resultsFromMatches [match]++ railsAutoLowLikelihood result `shouldReturn` True++ it "allows migrations" $ do+ let match = TermMatch "CreateUsers" "db/migrate/20160101120000_create_users.rb" 1+ let result = resultsFromMatches [match]++ railsAutoLowLikelihood result `shouldReturn` True++ it "disallows service objects" $ do+ let match = TermMatch "CreatePostWithNotifications" "app/services/create_post_with_notifications.rb" 1+ let result = resultsFromMatches [match]++ railsAutoLowLikelihood result `shouldReturn` False++ it "disallows methods" $ do+ let match = TermMatch "my_method" "app/services/create_post_with_notifications.rb" 1+ let result = resultsFromMatches [match]++ railsAutoLowLikelihood result `shouldReturn` False++ it "disallows models that occur in migrations" $ do+ let model = TermMatch "User" "app/models/user.rb" 1+ let migration = TermMatch "User" "db/migrate/20160101120000_create_users.rb" 1+ let result = resultsFromMatches [model, migration]++ railsAutoLowLikelihood result `shouldReturn` False++ it "allows matches intermixed with other results" $ do+ let appToken = TermMatch "ApplicationHelper" "app/helpers/application_helper.rb" 1+ let testToken = TermMatch "ApplicationHelper" "spec/helpers/application_helper_spec.rb" 10+ let result = resultsFromMatches [appToken, testToken]++ railsAutoLowLikelihood result `shouldReturn` True++ describe "elixirAutoLowLikelihood" $ do+ it "disallows controllers" $ do+ let match = TermMatch "PageController" "web/controllers/page_controller.rb" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` False++ it "allows views" $ do+ let match = TermMatch "PageView" "web/views/page_view.rb" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` True++ it "allows migrations" $ do+ let match = TermMatch "CreateUsers" "priv/repo/migrations/20160101120000_create_users.exs" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` True++ it "allows tests" $ do+ let match = TermMatch "UserTest" "test/models/user_test.exs" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` True++ it "allows Mixfile" $ do+ let match = TermMatch "Mixfile" "mix.exs" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` True++ it "allows __using__" $ do+ let match = TermMatch "__using__" "web/web.ex" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` True++ it "disallows service modules" $ do+ let match = TermMatch "CreatePostWithNotifications" "web/services/create_post_with_notifications.ex" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` False++ it "disallows functions" $ do+ let match = TermMatch "my_function" "web/services/create_post_with_notifications.ex" 1+ let result = resultsFromMatches [match]++ elixirAutoLowLikelihood result `shouldReturn` False++ it "allows matches intermixed with other results" $ do+ let appToken = TermMatch "UserView" "web/views/user_view.ex" 1+ let testToken = TermMatch "UserView" "test/views/user_view_test.exs" 10+ let result = resultsFromMatches [appToken, testToken]++ elixirAutoLowLikelihood result `shouldReturn` True++ describe "haskellAutoLowLikelihood" $ do+ it "allows instance" $ do+ let match = TermMatch "instance" "src/Lib/Types.hs" 1+ let result = resultsFromMatches [match]++ haskellAutoLowLikelihood result `shouldReturn` True++ it "allows items in the *.cabal file" $ do+ let match = TermMatch "Lib.SomethingSpec" "lib.cabal" 1+ let result = resultsFromMatches [match]++ haskellAutoLowLikelihood result `shouldReturn` True++ describe "autoLowLikelihood" $+ it "doesn't qualify as low when no matchers are present in a language config" $ do+ let match = TermMatch "AwesomeThing" "app/foo/awesome_thing.rb" 1+ let result = resultsFromMatches [match]+ let languageConfig = LanguageConfiguration "Bad" [] [LowLikelihoodMatch "Match with empty matchers" [] False] []++ autoLowLikelihood languageConfig result `shouldBe` False++configByName :: String -> IO LanguageConfiguration+configByName s = do+ (Right config) <- loadConfig+ let (Just config') = find ((==) s . lcName) config++ return config'++railsAutoLowLikelihood :: TermResults -> IO Bool+railsAutoLowLikelihood r = (`autoLowLikelihood` r) <$> configByName "Rails"++elixirAutoLowLikelihood :: TermResults -> IO Bool+elixirAutoLowLikelihood r = (`autoLowLikelihood` r) <$> configByName "Phoenix"++haskellAutoLowLikelihood :: TermResults -> IO Bool+haskellAutoLowLikelihood r = (`autoLowLikelihood` r) <$> configByName "Haskell"
+ test/Unused/TermSearch/InternalSpec.hs view
@@ -0,0 +1,30 @@+module Unused.TermSearch.InternalSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Unused.Types+import Unused.TermSearch.Internal++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+ describe "commandLineOptions" $ do+ it "does not use regular expressions when the term contains non-word characters" $ do+ commandLineOptions "can_do_things?" `shouldBe` ["can_do_things?", ".", "-Q", "-c", "--ackmate", "--ignore-dir", "tmp/unused"]+ commandLineOptions "no_way!" `shouldBe` ["no_way!", ".", "-Q", "-c", "--ackmate", "--ignore-dir", "tmp/unused"]+ commandLineOptions "[]=" `shouldBe` ["[]=", ".", "-Q", "-c", "--ackmate", "--ignore-dir", "tmp/unused"]+ commandLineOptions "window.globalOverride" `shouldBe` ["window.globalOverride", ".", "-Q", "-c", "--ackmate", "--ignore-dir", "tmp/unused"]++ it "uses regular expression match with surrounding non-word matches for accuracy" $+ commandLineOptions "awesome_method" `shouldBe` ["(\\W|^)awesome_method(\\W|$)", ".", "-c", "--ackmate", "--ignore-dir", "tmp/unused"]++ describe "parseSearchResult" $ do+ it "parses normal results from `ag` to a TermMatch" $+ parseSearchResult "method_name" ":app/models/foo.rb:123" `shouldBe` (Just $ TermMatch "method_name" "app/models/foo.rb" 123)++ it "returns Nothing when it cannot parse" $+ parseSearchResult "method_name" "" `shouldBe` Nothing
+ test/Unused/TypesSpec.hs view
@@ -0,0 +1,18 @@+module Unused.TypesSpec where++import Test.Hspec+import Unused.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $+ describe "resultsFromMatches" $+ it "batches files together to calculate information" $ do+ let matches = [ TermMatch "ApplicationController" "app/controllers/application_controller.rb" 1+ , TermMatch "ApplicationController" "spec/controllers/application_controller_spec.rb" 10+ ]++ resultsFromMatches matches `shouldBe`+ TermResults "ApplicationController" ["ApplicationController"] matches (Occurrences 1 10) (Occurrences 1 1) (Occurrences 2 11) (Removal NotCalculated "Likelihood not calculated") Nothing
+ test/Unused/UtilSpec.hs view
@@ -0,0 +1,36 @@+module Unused.UtilSpec+ ( main+ , spec+ ) where++import Test.Hspec+import Unused.Util++data Person = Person+ { pName :: String+ , pAge :: Int+ } deriving (Eq, Show)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+ describe "groupBy" $ do+ it "groups by the result of a function" $ do+ let numbers = [1..10] :: [Int]++ groupBy ((0 ==) . flip mod 2) numbers `shouldBe` [(False, [1, 3, 5, 7, 9]), (True, [2, 4, 6, 8, 10])]++ it "handles records" $ do+ let people = [Person "Jane" 10, Person "Jane" 20, Person "John" 20]++ groupBy pName people `shouldBe` [("Jane", [Person "Jane" 10, Person "Jane" 20]), ("John", [Person "John" 20])]+ groupBy pAge people `shouldBe` [(10, [Person "Jane" 10]), (20, [Person "Jane" 20, Person "John" 20])]++ describe "stringToInt" $+ it "converts a String value to Maybe Int" $ do+ stringToInt "12345678" `shouldBe` Just 12345678+ stringToInt "0" `shouldBe` Just 0+ stringToInt "10591" `shouldBe` Just 10591+ stringToInt "bad" `shouldBe` Nothing
+ unused.cabal view
@@ -0,0 +1,118 @@+name: unused+version: 0.5.0.2+synopsis: A command line tool to identify unused code.+description: Please see README.md+homepage: https://github.com/joshuaclayton/unused#readme+license: MIT+license-file: LICENSE+author: Josh Clayton+maintainer: sayhi@joshuaclayton.me+copyright: 2016 Josh Clayton+category: CLI+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10+data-files: data/config.yml++library+ hs-source-dirs: src+ exposed-modules: Unused.TermSearch+ , Unused.TermSearch.Types+ , Unused.TermSearch.Internal+ , Unused.Parser+ , Unused.Types+ , Unused.GitContext+ , Unused.Util+ , Unused.Regex+ , Unused.Aliases+ , Unused.ResponseFilter+ , Unused.ResultsClassifier+ , Unused.ResultsClassifier.Types+ , Unused.ResultsClassifier.Config+ , Unused.Grouping+ , Unused.Grouping.Internal+ , Unused.Grouping.Types+ , Unused.LikelihoodCalculator+ , Unused.Cache+ , Unused.Cache.DirectoryFingerprint+ , Unused.Cache.FindArgsFromIgnoredPaths+ , Unused.TagsSource+ , Unused.CLI+ , Unused.CLI.Search+ , Unused.CLI.GitContext+ , Unused.CLI.Util+ , Unused.CLI.Views+ , Unused.CLI.Views.Error+ , Unused.CLI.Views.NoResultsFound+ , Unused.CLI.Views.AnalysisHeader+ , Unused.CLI.Views.GitSHAsHeader+ , Unused.CLI.Views.MissingTagsFileError+ , Unused.CLI.Views.InvalidConfigError+ , Unused.CLI.Views.FingerprintError+ , 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+ other-modules: Paths_unused+ build-depends: base >= 4.7 && < 5+ , process+ , containers+ , filepath+ , directory+ , regex-tdfa+ , terminal-progress-bar+ , ansi-terminal+ , unix+ , parallel-io+ , yaml+ , bytestring+ , text+ , unordered-containers+ , cassava+ , vector+ , mtl+ , transformers+ ghc-options: -Wall+ default-language: Haskell2010++executable unused+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends: base+ , unused+ , optparse-applicative+ , mtl+ , transformers+ other-modules: App+ default-language: Haskell2010++test-suite unused-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , unused+ , hspec+ , containers+ other-modules: Unused.ParserSpec+ , Unused.ResponseFilterSpec+ , Unused.TypesSpec+ , Unused.LikelihoodCalculatorSpec+ , Unused.Grouping.InternalSpec+ , Unused.TermSearch.InternalSpec+ , Unused.UtilSpec+ , Unused.Cache.FindArgsFromIgnoredPathsSpec+ , Unused.AliasesSpec+ , Paths_unused+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/joshuaclayton/unused