unused 0.5.0.2 → 0.6.0.0
raw patch · 49 files changed
+610/−530 lines, 49 filesdep +inflectionsdep +megaparsec
Dependencies added: inflections, megaparsec
Files
- app/App.hs +42/−50
- app/Main.hs +11/−11
- data/config.yml +6/−4
- src/Unused/Aliases.hs +18/−48
- src/Unused/CLI.hs +1/−1
- src/Unused/CLI/GitContext.hs +6/−6
- src/Unused/CLI/ProgressIndicator.hs +14/−14
- src/Unused/CLI/ProgressIndicator/Internal.hs +14/−14
- src/Unused/CLI/ProgressIndicator/Types.hs +7/−7
- src/Unused/CLI/Search.hs +10/−10
- src/Unused/CLI/Util.hs +20/−20
- src/Unused/CLI/Views.hs +3/−3
- src/Unused/CLI/Views/AnalysisHeader.hs +1/−1
- src/Unused/CLI/Views/FingerprintError.hs +5/−5
- src/Unused/CLI/Views/InvalidConfigError.hs +4/−4
- src/Unused/CLI/Views/MissingTagsFileError.hs +7/−4
- src/Unused/CLI/Views/SearchResult.hs +6/−6
- src/Unused/CLI/Views/SearchResult/ColumnFormatter.hs +1/−1
- src/Unused/CLI/Views/SearchResult/ListResult.hs +20/−19
- src/Unused/CLI/Views/SearchResult/TableResult.hs +14/−14
- src/Unused/CLI/Views/SearchResult/Types.hs +3/−4
- src/Unused/Cache.hs +14/−14
- src/Unused/Cache/DirectoryFingerprint.hs +17/−16
- src/Unused/Cache/FindArgsFromIgnoredPaths.hs +7/−7
- src/Unused/GitContext.hs +4/−4
- src/Unused/Grouping.hs +7/−9
- src/Unused/Grouping/Internal.hs +8/−17
- src/Unused/LikelihoodCalculator.hs +11/−15
- src/Unused/Parser.hs +13/−15
- src/Unused/Projection.hs +52/−0
- src/Unused/Projection/Transform.hs +37/−0
- src/Unused/ResponseFilter.hs +8/−8
- src/Unused/ResultsClassifier.hs +1/−1
- src/Unused/ResultsClassifier/Config.hs +24/−23
- src/Unused/ResultsClassifier/Types.hs +21/−17
- src/Unused/TagsSource.hs +10/−6
- src/Unused/TermSearch.hs +10/−10
- src/Unused/TermSearch/Internal.hs +13/−14
- src/Unused/TermSearch/Types.hs +1/−5
- src/Unused/Types.hs +34/−19
- src/Unused/Util.hs +25/−13
- test/Unused/AliasesSpec.hs +8/−4
- test/Unused/Grouping/InternalSpec.hs +5/−5
- test/Unused/LikelihoodCalculatorSpec.hs +16/−16
- test/Unused/ParserSpec.hs +16/−16
- test/Unused/ResponseFilterSpec.hs +24/−24
- test/Unused/TermSearch/InternalSpec.hs +3/−3
- test/Unused/TypesSpec.hs +2/−2
- unused.cabal +6/−1
app/App.hs view
@@ -7,21 +7,22 @@ , 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 Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError)+import Control.Monad.Reader (ReaderT, MonadReader, MonadIO, runReaderT, asks, liftIO)+import qualified Data.Bifunctor as BF+import qualified Data.Bool as B+import qualified Data.Maybe as M+import Unused.Aliases (termsAndAliases)+import Unused.CLI (SearchRunner(..), loadGitContext, renderHeader, executeSearch, withRuntime) import qualified Unused.CLI.Views as V+import Unused.Cache (FingerprintOutcome(..), cached)+import Unused.Grouping (CurrentGrouping(..), groupedResponses)+import Unused.Parser (parseResults)+import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)+import Unused.ResultsClassifier (ParseConfigError, LanguageConfiguration(..), loadAllConfigurations)+import Unused.TagsSource (TagSearchOutcome, loadTagsFromFile, loadTagsFromPipe)+import Unused.TermSearch (SearchResults(..), SearchTerm, fromResults)+import Unused.Types (TermMatchSet, RemovalLikelihood(..)) type AppConfig = MonadReader Options @@ -48,7 +49,8 @@ runProgram :: Options -> IO () runProgram options = withRuntime $- runExceptT (runReaderT (runApp run) options) >>= either renderError return+ either renderError return+ =<< runExceptT (runReaderT (runApp run) options) run :: App () run = do@@ -59,7 +61,7 @@ printResults =<< retrieveGitContext =<< fmap (`parseResults` results) loadAllConfigs -termsWithAlternatesFromConfig :: App [String]+termsWithAlternatesFromConfig :: App [SearchTerm] termsWithAlternatesFromConfig = do aliases <- concatMap lcTermAliases <$> loadAllConfigs terms <- calculateTagInput@@ -72,36 +74,33 @@ 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+retrieveGitContext tms =+ maybe (return tms) (liftIO . flip loadGitContext tms)+ =<< numberOfCommits printResults :: TermMatchSet -> App ()-printResults ts = do- filters <- optionFilters ts+printResults tms = do+ filters <- optionFilters tms 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+loadAllConfigs =+ either throwError return+ =<< BF.first InvalidConfigError <$> liftIO loadAllConfigurations 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+calculateTagInput =+ either throwError return+ =<< liftIO .+ fmap (BF.first TagError) .+ B.bool loadTagsFromFile loadTagsFromPipe =<< readFromStdIn withCache :: IO SearchResults -> App SearchResults withCache f =- operateCache =<< runWithCache+ B.bool (liftIO f) (withCache' f) =<< runWithCache where- operateCache b = if b then withCache' f else liftIO f withCache' :: IO SearchResults -> App SearchResults withCache' r = either (throwError . CacheError) (return . SearchResults) =<<@@ -118,15 +117,12 @@ ] singleOccurrenceFilter :: AppConfig m => TermMatchSet -> m TermMatchSet-singleOccurrenceFilter tms = do- allowsSingleOccurrence <- oSingleOccurrenceMatches <$> ask- return $ if allowsSingleOccurrence- then withOneOccurrence tms- else tms+singleOccurrenceFilter tms =+ B.bool tms (withOneOccurrence tms) <$> asks oSingleOccurrenceMatches likelihoodsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet likelihoodsFilter tms =- withLikelihoods . likelihoods <$> ask <*> pure tms+ asks $ withLikelihoods . likelihoods <*> pure tms where likelihoods options | oAllLikelihoods options = [High, Medium, Low]@@ -134,26 +130,22 @@ | otherwise = oLikelihoods options ignoredPathsFilter :: AppConfig m => TermMatchSet -> m TermMatchSet-ignoredPathsFilter tms = ignoringPaths . oIgnoredPaths <$> ask <*> pure tms+ignoredPathsFilter tms = asks $ ignoringPaths . oIgnoredPaths <*> pure tms readFromStdIn :: AppConfig m => m Bool-readFromStdIn = oFromStdIn <$> ask+readFromStdIn = asks oFromStdIn groupingOptions :: AppConfig m => m CurrentGrouping-groupingOptions = oGrouping <$> ask+groupingOptions = asks oGrouping searchRunner :: AppConfig m => m SearchRunner-searchRunner = oSearchRunner <$> ask+searchRunner = asks oSearchRunner runWithCache :: AppConfig m => m Bool-runWithCache = not . oWithoutCache <$> ask+runWithCache = asks $ not . oWithoutCache numberOfCommits :: AppConfig m => m (Maybe Int)-numberOfCommits = oCommitCount <$> ask+numberOfCommits = asks oCommitCount resultFormatter :: AppConfig m => m V.ResultsFormat-resultFormatter = do- c <- numberOfCommits- return $ if isJust c- then V.List- else V.Column+resultFormatter = B.bool V.Column V.List . M.isJust <$> numberOfCommits
app/Main.hs view
@@ -1,12 +1,12 @@ 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)+import App (runProgram, Options(Options))+import qualified Data.Maybe as M+import Options.Applicative+import Unused.CLI (SearchRunner(..))+import Unused.Grouping (CurrentGrouping(..))+import Unused.Types (RemovalLikelihood(..))+import Unused.Util (stringToInt) main :: IO () main = runProgram =<< parseCLI@@ -16,9 +16,9 @@ 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."+ 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@@ -80,7 +80,7 @@ parseGroupings :: Parser CurrentGrouping parseGroupings =- fromMaybe GroupByDirectory <$> maybeGroup+ M.fromMaybe GroupByDirectory <$> maybeGroup where maybeGroup = optional $ parseGrouping <$> parseGroupingOption
data/config.yml view
@@ -1,9 +1,11 @@ - name: Rails aliases:- - from: "%s?"- to: "be_%s"- - from: "has_%s?"- to: "have_%s"+ - from: "*?"+ to: "be_{}"+ - from: "has_*?"+ to: "have_{}"+ - from: "*Validator"+ to: "{snakecase}" allowedTerms: # serialization - as_json
src/Unused/Aliases.hs view
@@ -5,55 +5,28 @@ , termsAndAliases ) where -import Data.Tuple (swap)-import Data.List (nub, sort, find, (\\))-import Data.Text (Text)+import qualified Data.List as L+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'+import Unused.ResultsClassifier.Types+import Unused.Types (SearchTerm(..), TermMatch, tmTerm)+import Unused.Util (groupBy) -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+groupedTermsAndAliases :: [TermMatch] -> [[TermMatch]]+groupedTermsAndAliases = map snd . groupBy tmTerm -toAlias :: TermAlias -> Alias-toAlias TermAlias{taFrom = from, taTo = to} = (T.pack from, T.pack to)+termsAndAliases :: [TermAlias] -> [String] -> [SearchTerm]+termsAndAliases [] = map OriginalTerm+termsAndAliases as = L.nub . concatMap ((as >>=) . generateSearchTerms . T.pack) -generateAliases :: Alias -> Text -> [Text]-generateAliases (from, to) term =- toTermWithAlias $ parsePatternForMatch from term+generateSearchTerms :: Text -> TermAlias -> [SearchTerm]+generateSearchTerms term TermAlias{taFrom = from, taTransform = transform} =+ toTermWithAlias $ parsePatternForMatch (T.pack from) term where- toTermWithAlias (Right (Just match)) = [term, T.replace wildcard match to]- toTermWithAlias _ = [term]+ toTermWithAlias (Right (Just match)) = [OriginalTerm unpackedTerm, AliasTerm unpackedTerm (aliasedResult match)]+ toTermWithAlias _ = [OriginalTerm unpackedTerm]+ unpackedTerm = T.unpack term+ aliasedResult = T.unpack . transform parsePatternForMatch :: Text -> Text -> Either Text (Maybe Text) parsePatternForMatch aliasPattern term =@@ -62,8 +35,5 @@ 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"+wildcard = "*"
src/Unused/CLI.hs view
@@ -2,6 +2,6 @@ ( module X ) where -import Unused.CLI.Search as X import Unused.CLI.GitContext as X+import Unused.CLI.Search as X import Unused.CLI.Util as X
src/Unused/CLI/GitContext.hs view
@@ -2,16 +2,16 @@ ( loadGitContext ) where -import Data.Map.Strict as Map (toList, fromList)-import Unused.Types (TermMatchSet)-import Unused.CLI.Util+import qualified Data.Map.Strict as Map+import Unused.CLI.ProgressIndicator (createProgressBar, progressWithIndicator)+import qualified Unused.CLI.Util as U import qualified Unused.CLI.Views as V-import Unused.CLI.ProgressIndicator-import Unused.GitContext+import Unused.GitContext (gitContextForResults)+import Unused.Types (TermMatchSet) loadGitContext :: Int -> TermMatchSet -> IO TermMatchSet loadGitContext i tms = do- resetScreen+ U.resetScreen V.loadingSHAsHeader i Map.fromList <$> progressWithIndicator (gitContextForResults i) createProgressBar listTerms where
src/Unused/CLI/ProgressIndicator.hs view
@@ -1,30 +1,30 @@ module Unused.CLI.ProgressIndicator- ( ProgressIndicator+ ( I.ProgressIndicator , createProgressBar , createSpinner , progressWithIndicator ) where -import Control.Concurrent.ParallelIO-import Unused.CLI.Util-import Unused.CLI.ProgressIndicator.Types-import Unused.CLI.ProgressIndicator.Internal+import qualified Control.Concurrent.ParallelIO as PIO+import qualified Unused.CLI.ProgressIndicator.Internal as I+import qualified Unused.CLI.ProgressIndicator.Types as I+import Unused.CLI.Util (Color(..), installChildInterruptHandler) -createProgressBar :: ProgressIndicator-createProgressBar = ProgressBar Nothing Nothing+createProgressBar :: I.ProgressIndicator+createProgressBar = I.ProgressBar Nothing Nothing -createSpinner :: ProgressIndicator+createSpinner :: I.ProgressIndicator createSpinner =- Spinner snapshots (length snapshots) 75000 colors Nothing+ I.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 :: Monoid b => (a -> IO b) -> I.ProgressIndicator -> [a] -> IO b progressWithIndicator f i terms = do- printPrefix i- (tid, indicator) <- start i $ length terms+ I.printPrefix i+ (tid, indicator) <- I.start i $ length terms installChildInterruptHandler tid- mconcat <$> parallel (ioOps indicator) <* stop indicator+ mconcat <$> PIO.parallel (ioOps indicator) <* I.stop indicator where- ioOps i' = map (\t -> f t <* increment i') terms+ ioOps i' = map (\t -> f t <* I.increment i') terms
src/Unused/CLI/ProgressIndicator/Internal.hs view
@@ -5,27 +5,27 @@ , 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+import qualified Control.Concurrent as CC+import qualified Control.Monad as M+import qualified System.ProgressBar as PB+import Unused.CLI.ProgressIndicator.Types (ProgressIndicator(..))+import Unused.CLI.Util -start :: ProgressIndicator -> Int -> IO (ThreadId, ProgressIndicator)+start :: ProgressIndicator -> Int -> IO (CC.ThreadId, ProgressIndicator) start s@Spinner{} _ = do- tid <- forkIO $ runSpinner 0 s+ tid <- CC.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 ProgressBar{ pbThreadId = Just tid } = CC.killThread tid+stop Spinner{ sThreadId = Just tid } = CC.killThread tid stop _ = return () increment :: ProgressIndicator -> IO ()-increment ProgressBar{ pbProgressRef = Just ref } = incProgress ref 1+increment ProgressBar{ pbProgressRef = Just ref } = PB.incProgress ref 1 increment _ = return () printPrefix :: ProgressIndicator -> IO ()@@ -33,11 +33,11 @@ printPrefix Spinner{} = putStr " " runSpinner :: Int -> ProgressIndicator -> IO ()-runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = forever $ do+runSpinner i s@Spinner{ sDelay = delay, sSnapshots = snapshots, sColors = colors, sLength = length' } = M.forever $ do setSGR [SetColor Foreground Dull currentColor] putStr currentSnapshot cursorBackward 1- threadDelay delay+ CC.threadDelay delay runSpinner (i + 1) s where currentSnapshot = snapshots !! (i `mod` snapshotLength)@@ -45,9 +45,9 @@ snapshotLength = length' runSpinner _ _ = return () -buildProgressBar :: Integer -> IO (ProgressRef, ThreadId)+buildProgressBar :: Integer -> IO (PB.ProgressRef, CC.ThreadId) buildProgressBar =- startProgress (msg message) percentage progressBarWidth+ PB.startProgress (PB.msg message) PB.percentage progressBarWidth where message = "Working" progressBarWidth = 60
src/Unused/CLI/ProgressIndicator/Types.hs view
@@ -2,19 +2,19 @@ ( ProgressIndicator(..) ) where -import Control.Concurrent (ThreadId)-import System.ProgressBar (ProgressRef)-import System.Console.ANSI (Color)+import qualified Control.Concurrent as CC+import qualified System.Console.ANSI as ANSI+import qualified System.ProgressBar as PB data ProgressIndicator = Spinner { sSnapshots :: [String] , sLength :: Int , sDelay :: Int- , sColors :: [Color]- , sThreadId :: Maybe ThreadId+ , sColors :: [ANSI.Color]+ , sThreadId :: Maybe CC.ThreadId } | ProgressBar- { pbProgressRef :: Maybe ProgressRef- , pbThreadId :: Maybe ThreadId+ { pbProgressRef :: Maybe PB.ProgressRef+ , pbThreadId :: Maybe CC.ThreadId }
src/Unused/CLI/Search.hs view
@@ -4,23 +4,23 @@ , executeSearch ) where -import Unused.TermSearch (SearchResults, search)-import Unused.CLI.Util+import qualified Unused.CLI.ProgressIndicator as I+import qualified Unused.CLI.Util as U import qualified Unused.CLI.Views as V-import Unused.CLI.ProgressIndicator+import qualified Unused.TermSearch as TS data SearchRunner = SearchWithProgress | SearchWithoutProgress -renderHeader :: [String] -> IO ()+renderHeader :: [a] -> IO () renderHeader terms = do- resetScreen+ U.resetScreen V.analysisHeader terms -executeSearch :: SearchRunner -> [String] -> IO SearchResults+executeSearch :: SearchRunner -> [TS.SearchTerm] -> IO TS.SearchResults executeSearch runner terms = do renderHeader terms- runSearch runner terms <* resetScreen+ runSearch runner terms <* U.resetScreen -runSearch :: SearchRunner -> [String] -> IO SearchResults-runSearch SearchWithProgress = progressWithIndicator search createProgressBar-runSearch SearchWithoutProgress = progressWithIndicator search createSpinner+runSearch :: SearchRunner -> [TS.SearchTerm] -> IO TS.SearchResults+runSearch SearchWithProgress = I.progressWithIndicator TS.search I.createProgressBar+runSearch SearchWithoutProgress = I.progressWithIndicator TS.search I.createSpinner
src/Unused/CLI/Util.hs view
@@ -5,19 +5,19 @@ , 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))+import qualified Control.Concurrent as CC+import qualified Control.Concurrent.ParallelIO as PIO+import qualified Control.Exception as E+import qualified Control.Monad as M+import System.Console.ANSI+import qualified System.Exit as Ex+import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)+import qualified System.Posix.Signals as S withRuntime :: IO a -> IO a withRuntime a = do hSetBuffering stdout NoBuffering- withInterruptHandler $ withoutCursor a <* stopGlobalPool+ withInterruptHandler $ withoutCursor a <* PIO.stopGlobalPool resetScreen :: IO () resetScreen = do@@ -31,30 +31,30 @@ withInterruptHandler :: IO a -> IO a withInterruptHandler body = do- tid <- myThreadId- void $ installHandler keyboardSignal (Catch (handleInterrupt tid)) Nothing+ tid <- CC.myThreadId+ M.void $ S.installHandler S.keyboardSignal (S.Catch (handleInterrupt tid)) Nothing body -installChildInterruptHandler :: ThreadId -> IO ()+installChildInterruptHandler :: CC.ThreadId -> IO () installChildInterruptHandler tid = do- currentThread <- myThreadId- void $ installHandler keyboardSignal (Catch (handleChildInterrupt currentThread tid)) Nothing+ currentThread <- CC.myThreadId+ M.void $ S.installHandler S.keyboardSignal (S.Catch (handleChildInterrupt currentThread tid)) Nothing -handleInterrupt :: ThreadId -> IO ()+handleInterrupt :: CC.ThreadId -> IO () handleInterrupt tid = do resetScreenState- throwTo tid $ ExitFailure interruptExitCode+ E.throwTo tid $ Ex.ExitFailure interruptExitCode -handleChildInterrupt :: ThreadId -> ThreadId -> IO ()+handleChildInterrupt :: CC.ThreadId -> CC.ThreadId -> IO () handleChildInterrupt parentTid childTid = do- killThread childTid+ CC.killThread childTid resetScreenState- throwTo parentTid $ ExitFailure interruptExitCode+ E.throwTo parentTid $ Ex.ExitFailure interruptExitCode handleInterrupt parentTid interruptExitCode :: Int interruptExitCode =- signalToInt $ 128 + keyboardSignal+ signalToInt $ 128 + S.keyboardSignal where signalToInt s = read $ show s :: Int
src/Unused/CLI/Views.hs view
@@ -2,10 +2,10 @@ ( module X ) where -import Unused.CLI.Views.NoResultsFound as X import Unused.CLI.Views.AnalysisHeader as X+import Unused.CLI.Views.FingerprintError 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.MissingTagsFileError as X+import Unused.CLI.Views.NoResultsFound as X import Unused.CLI.Views.SearchResult as X
src/Unused/CLI/Views/AnalysisHeader.hs view
@@ -4,7 +4,7 @@ import Unused.CLI.Util -analysisHeader :: [String] -> IO ()+analysisHeader :: [a] -> IO () analysisHeader terms = do setSGR [SetConsoleIntensity BoldIntensity] putStr "Unused: "
src/Unused/CLI/Views/FingerprintError.hs view
@@ -2,13 +2,13 @@ ( fingerprintError ) where -import Data.List (intercalate)-import Unused.Cache.DirectoryFingerprint-import Unused.CLI.Views.Error+import qualified Data.List as L+import qualified Unused.CLI.Views.Error as V+import Unused.Cache.DirectoryFingerprint (FingerprintOutcome(..)) fingerprintError :: FingerprintOutcome -> IO () fingerprintError e = do- errorHeader "There was a problem generating a cache fingerprint:"+ V.errorHeader "There was a problem generating a cache fingerprint:" printOutcomeMessage e @@ -16,4 +16,4 @@ printOutcomeMessage (MD5ExecutableNotFound execs) = putStrLn $ "Unable to find any of the following executables \- \in your PATH: " ++ intercalate ", " execs+ \in your PATH: " ++ L.intercalate ", " execs
src/Unused/CLI/Views/InvalidConfigError.hs view
@@ -2,13 +2,13 @@ ( invalidConfigError ) where -import Unused.CLI.Util-import Unused.CLI.Views.Error-import Unused.ResultsClassifier (ParseConfigError(..))+import Unused.CLI.Util+import qualified Unused.CLI.Views.Error as V+import Unused.ResultsClassifier (ParseConfigError(..)) invalidConfigError :: [ParseConfigError] -> IO () invalidConfigError es = do- errorHeader "There was a problem with the following config file(s):"+ V.errorHeader "There was a problem with the following config file(s):" mapM_ configError es
src/Unused/CLI/Views/MissingTagsFileError.hs view
@@ -2,13 +2,13 @@ ( missingTagsFileError ) where -import Unused.TagsSource-import Unused.CLI.Util-import Unused.CLI.Views.Error+import Unused.CLI.Util+import qualified Unused.CLI.Views.Error as V+import Unused.TagsSource (TagSearchOutcome(..)) missingTagsFileError :: TagSearchOutcome -> IO () missingTagsFileError e = do- errorHeader "There was a problem finding a tags file."+ V.errorHeader "There was a problem finding a tags file." printOutcomeMessage e putStr "\n"@@ -40,3 +40,6 @@ printOutcomeMessage (TagsFileNotFound directoriesSearched) = do putStrLn "Looked for a 'tags' file in the following directories:\n" mapM_ (\d -> putStrLn $ "* " ++ d) directoriesSearched+printOutcomeMessage (IOError e) = do+ putStrLn "Received error when loading tags file:\n"+ putStrLn $ " " ++ show e
src/Unused/CLI/Views/SearchResult.hs view
@@ -3,16 +3,16 @@ , searchResults ) where -import Control.Arrow ((&&&))+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 Unused.CLI.Util import qualified Unused.CLI.Views.NoResultsFound as V+import Unused.CLI.Views.SearchResult.ColumnFormatter import qualified Unused.CLI.Views.SearchResult.ListResult as V import qualified Unused.CLI.Views.SearchResult.TableResult as V+import Unused.CLI.Views.SearchResult.Types+import Unused.Grouping (Grouping(..), GroupedTerms)+import Unused.Types (TermMatchSet, TermResults(..), TermMatch) searchResults :: ResultsFormat -> [GroupedTerms] -> IO () searchResults format terms = do
src/Unused/CLI/Views/SearchResult/ColumnFormatter.hs view
@@ -3,7 +3,7 @@ , buildColumnFormatter ) where -import Text.Printf+import Text.Printf (printf) import Unused.Types (TermResults(..), TermMatch(..), totalFileCount, totalOccurrenceCount) data ColumnFormat = ColumnFormat
src/Unused/CLI/Views/SearchResult/ListResult.hs view
@@ -2,30 +2,31 @@ ( 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+import qualified Control.Monad as M+import Data.List ((\\))+import qualified Data.List as L+import Unused.CLI.Util+import qualified Unused.CLI.Views.SearchResult.Internal as SR+import qualified Unused.CLI.Views.SearchResult.Types as SR+import Unused.Types (TermResults(..), GitContext(..), GitCommit(..), TermMatch(..), tmDisplayTerm, totalFileCount, totalOccurrenceCount) -printList :: TermResults -> [TermMatch] -> ResultsPrinter ()-printList r ms = liftIO $- forM_ ms $ \m -> do- printTermAndOccurrences r+printList :: TermResults -> [TermMatch] -> SR.ResultsPrinter ()+printList r ms = SR.liftIO $+ M.forM_ ms $ \m -> do+ printTermAndOccurrences r m printAliases r printFilePath m printSHAs r printRemovalReason r putStr "\n" -printTermAndOccurrences :: TermResults -> IO ()-printTermAndOccurrences r = do- setSGR [SetColor Foreground Dull (termColor r)]+printTermAndOccurrences :: TermResults -> TermMatch -> IO ()+printTermAndOccurrences r m = do+ setSGR [SetColor Foreground Dull (SR.termColor r)] setSGR [SetConsoleIntensity BoldIntensity] putStr " " setSGR [SetUnderlining SingleUnderline]- putStr $ trTerm r+ putStr $ tmDisplayTerm m setSGR [Reset] setSGR [SetColor Foreground Vivid Cyan]@@ -39,9 +40,9 @@ putStr "\n" printAliases :: TermResults -> IO ()-printAliases r = when anyAliases $ do+printAliases r = M.when anyAliases $ do printHeader " Aliases: "- putStrLn $ intercalate ", " remainingAliases+ putStrLn $ L.intercalate ", " remainingAliases where anyAliases = not $ null remainingAliases remainingAliases = trTerms r \\ [trTerm r]@@ -56,17 +57,17 @@ printSHAs :: TermResults -> IO () printSHAs r = case mshas of- Nothing -> void $ putStr ""+ Nothing -> M.void $ putStr "" Just shas' -> do printHeader " Recent SHAs: "- putStrLn $ intercalate ", " shas'+ putStrLn $ L.intercalate ", " shas' where mshas = (map gcSha . gcCommits) <$> trGitContext r printRemovalReason :: TermResults -> IO () printRemovalReason r = do printHeader " Reason: "- putStrLn $ removalReason r+ putStrLn $ SR.removalReason r printHeader :: String -> IO () printHeader v = do
src/Unused/CLI/Views/SearchResult/TableResult.hs view
@@ -2,23 +2,23 @@ ( 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+import Control.Monad (forM_)+import Unused.CLI.Util+import qualified Unused.CLI.Views.SearchResult.Internal as SR+import qualified Unused.CLI.Views.SearchResult.Types as SR+import Unused.Types (TermResults, TermMatch(..), tmDisplayTerm, totalFileCount, totalOccurrenceCount) -printTable :: TermResults -> [TermMatch] -> ResultsPrinter ()+printTable :: TermResults -> [TermMatch] -> SR.ResultsPrinter () printTable r ms = do- cf <- columnFormat- let printTerm = cfPrintTerm cf- let printPath = cfPrintPath cf- let printNumber = cfPrintNumber cf+ cf <- SR.columnFormat+ let printTerm = SR.cfPrintTerm cf+ let printPath = SR.cfPrintPath cf+ let printNumber = SR.cfPrintNumber cf - liftIO $ forM_ ms $ \m -> do- setSGR [SetColor Foreground Dull (termColor r)]+ SR.liftIO $ forM_ ms $ \m -> do+ setSGR [SetColor Foreground Dull (SR.termColor r)] setSGR [SetConsoleIntensity NormalIntensity]- putStr $ " " ++ printTerm (tmTerm m)+ putStr $ " " ++ printTerm (tmDisplayTerm m) setSGR [Reset] setSGR [SetColor Foreground Vivid Cyan]@@ -31,5 +31,5 @@ putStr $ " " ++ printPath (tmPath m) setSGR [Reset] - putStr $ " " ++ removalReason r+ putStr $ " " ++ SR.removalReason r putStr "\n"
src/Unused/CLI/Views/SearchResult/Types.hs view
@@ -6,12 +6,11 @@ , columnFormat , outputFormat , R.runReaderT- , M.liftIO+ , R.liftIO ) where -import qualified Control.Monad.Trans.Reader as R-import qualified Control.Monad.IO.Class as M-import Unused.CLI.Views.SearchResult.ColumnFormatter+import qualified Control.Monad.Reader as R+import Unused.CLI.Views.SearchResult.ColumnFormatter data ResultsOptions = ResultsOptions { roColumnFormat :: ColumnFormat
src/Unused/Cache.hs view
@@ -3,13 +3,13 @@ , 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 Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO) import qualified Data.ByteString.Lazy as BS-import Unused.Cache.DirectoryFingerprint+import Data.Csv (FromRecord, ToRecord, HasHeader(..), encode, decode)+import qualified Data.Vector as V+import qualified System.Directory as D+import Unused.Cache.DirectoryFingerprint (FingerprintOutcome(..), sha)+import Unused.Util (safeReadFile) newtype CacheFileName = CacheFileName String type Cache = ReaderT CacheFileName IO@@ -23,7 +23,7 @@ writeCache :: ToRecord a => [a] -> Cache [a] writeCache [] = return [] writeCache contents = do- liftIO $ createDirectoryIfMissing True cacheDirectory+ liftIO $ D.createDirectoryIfMissing True cacheDirectory (CacheFileName fileName) <- ask liftIO $ BS.writeFile fileName $ encode contents return contents@@ -31,20 +31,20 @@ 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+ either+ (const Nothing)+ (processCsv . decode NoHeader)+ <$> liftIO (safeReadFile fileName) where- processCsv = either (const Nothing) (Just . toList)+ processCsv = either (const Nothing) (Just . V.toList) cacheFileName :: String -> IO (Either FingerprintOutcome CacheFileName) cacheFileName context = do putStrLn "\n\nCalculating cache fingerprint... "- fmap toFileName <$> sha+ fmap (CacheFileName . toFileName) <$> sha where- toFileName s = CacheFileName $ cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv"+ toFileName s = cacheDirectory ++ "/" ++ context ++ "-" ++ s ++ ".csv" cacheDirectory :: String cacheDirectory = "tmp/unused"
src/Unused/Cache/DirectoryFingerprint.hs view
@@ -3,17 +3,18 @@ , sha ) where -import System.Process-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Reader-import qualified System.Directory as D+import Control.Monad.Reader (ReaderT, runReaderT, asks, liftIO) import qualified Data.Char as C-import Data.Maybe (fromMaybe)-import Unused.Cache.FindArgsFromIgnoredPaths-import Unused.Util (safeHead, readIfFileExists)+import qualified Data.Maybe as M+import qualified System.Directory as D+import qualified System.Process as P+import Unused.Cache.FindArgsFromIgnoredPaths (findArgs)+import Unused.Util (safeHead, safeReadFile) -type MD5Config = ReaderT String IO+newtype MD5ExecutablePath = MD5ExecutablePath { toMD5String :: String } +type MD5Config = ReaderT MD5ExecutablePath IO+ data FingerprintOutcome = MD5ExecutableNotFound [String] @@ -22,28 +23,28 @@ md5Executable' <- md5Executable case md5Executable' of Just exec ->- Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) exec+ Right . getSha <$> runReaderT (fileList >>= sortInput >>= md5Result) (MD5ExecutablePath exec) Nothing -> return $ Left $ MD5ExecutableNotFound supportedMD5Executables where- getSha = takeWhile C.isAlphaNum . fromMaybe "" . safeHead . lines+ getSha = takeWhile C.isAlphaNum . M.fromMaybe "" . safeHead . lines fileList :: MD5Config String fileList = do filterNamePathArgs <- liftIO $ findArgs <$> ignoredPaths- md5exec <- ask+ md5exec <- asks toMD5String let args = [".", "-type", "f", "-not", "-path", "*/.git/*"] ++ filterNamePathArgs ++ ["-exec", md5exec, "{}", "+"]- liftIO $ readProcess "find" args ""+ liftIO $ P.readProcess "find" args "" sortInput :: String -> MD5Config String-sortInput = liftIO . readProcess "sort" ["-k", "2"]+sortInput = liftIO . P.readProcess "sort" ["-k", "2"] md5Result :: String -> MD5Config String md5Result r = do- md5exec <- ask- liftIO $ readProcess md5exec [] r+ md5exec <- asks toMD5String+ liftIO $ P.readProcess md5exec [] r ignoredPaths :: IO [String]-ignoredPaths = fromMaybe [] <$> (fmap lines <$> readIfFileExists ".gitignore")+ignoredPaths = either (const []) id <$> (fmap lines <$> safeReadFile ".gitignore") md5Executable :: IO (Maybe String) md5Executable =
src/Unused/Cache/FindArgsFromIgnoredPaths.hs view
@@ -2,9 +2,9 @@ ( findArgs ) where -import Data.Char (isAlphaNum)-import Data.List (isSuffixOf)-import System.FilePath+import qualified Data.Char as C+import qualified Data.List as L+import qualified System.FilePath as FP findArgs :: [String] -> [String] findArgs = concatMap ignoreToFindArgs . validIgnoreOptions@@ -28,14 +28,14 @@ wildcardSuffix :: String -> String wildcardSuffix s | isWildcardFilename s = s- | "/" `isSuffixOf` s = s ++ "*"+ | "/" `L.isSuffixOf` s = s ++ "*" | otherwise = s ++ "/*" isWildcardFilename :: String -> Bool-isWildcardFilename = elem '*' . takeFileName+isWildcardFilename = elem '*' . FP.takeFileName isMissingFilename :: String -> Bool-isMissingFilename s = takeFileName s == ""+isMissingFilename = null . FP.takeFileName validIgnoreOptions :: [String] -> [String] validIgnoreOptions =@@ -44,4 +44,4 @@ isPath "" = False isPath ('/':_) = True isPath ('.':_) = True- isPath s = isAlphaNum $ head s+ isPath s = C.isAlphaNum $ head s
src/Unused/GitContext.hs view
@@ -4,10 +4,10 @@ ( 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)+import qualified Data.Text as T+import qualified System.Process as P+import Unused.Types (TermResults(trGitContext), GitContext(..), GitCommit(..), RemovalLikelihood(High), removalLikelihood, resultAliases) newtype GitOutput = GitOutput { unOutput :: String } @@ -31,5 +31,5 @@ gitLogSearchFor :: Int -> [String] -> IO GitOutput gitLogSearchFor commitCount ts = do- (_, results, _) <- readProcessWithExitCode "git" ["log", "-G", L.intercalate "|" ts, "--oneline", "-n", show commitCount] ""+ (_, results, _) <- P.readProcessWithExitCode "git" ["log", "-G", L.intercalate "|" ts, "--oneline", "-n", show commitCount] "" return $ GitOutput results
src/Unused/Grouping.hs view
@@ -5,12 +5,12 @@ , groupedResponses ) where +import qualified Data.List as L 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+import Unused.Grouping.Internal (groupFilter)+import Unused.Grouping.Types (Grouping(..), CurrentGrouping(..), GroupFilter, GroupedTerms)+import Unused.ResponseFilter (updateMatches)+import Unused.Types (TermMatchSet, TermResults(trMatches)) groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms] groupedResponses g tms =@@ -21,12 +21,10 @@ groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet groupedMatchSetSubsets f tms =- updateMatches newMatches- where- newMatches = filter ((== tms) . f)+ updateMatches $ filter ((== tms) . f) allGroupings :: GroupFilter -> TermMatchSet -> [Grouping] allGroupings f = uniqueValues . Map.map (fmap f . trMatches) where- uniqueValues = sort . nub . concat . Map.elems+ uniqueValues = L.sort . L.nub . concat . Map.elems
src/Unused/Grouping/Internal.hs view
@@ -2,26 +2,17 @@ ( groupFilter ) where -import Unused.Grouping.Types-import System.FilePath (takeDirectory, splitDirectories)-import Unused.Types (tmPath, tmTerm)-import Data.List (intercalate)+import qualified Data.List as L+import qualified System.FilePath as FP+import Unused.Grouping.Types (CurrentGrouping(..), Grouping(..), GroupFilter)+import qualified Unused.Types as T groupFilter :: CurrentGrouping -> GroupFilter-groupFilter GroupByDirectory = fileNameGrouping-groupFilter GroupByTerm = termGrouping-groupFilter GroupByFile = fileGrouping+groupFilter GroupByDirectory = ByDirectory . shortenedDirectory . T.tmPath+groupFilter GroupByTerm = ByTerm . T.tmTerm+groupFilter GroupByFile = ByFile . T.tmPath 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+ L.intercalate "/" . take 2 . FP.splitDirectories . FP.takeDirectory
src/Unused/LikelihoodCalculator.hs view
@@ -3,38 +3,34 @@ , LanguageConfiguration ) where -import Data.Maybe (isJust)-import Data.List (find, intercalate)-import Unused.ResultsClassifier-import Unused.Types-import Unused.ResponseFilter (autoLowLikelihood)+import qualified Data.List as L+import qualified Data.Maybe as M+import qualified Unused.ResponseFilter as RF+import Unused.ResultsClassifier (LanguageConfiguration(..), LowLikelihoodMatch(..))+import Unused.Types (TermResults(..), Occurrences(..), RemovalLikelihood(..), Removal(..), totalOccurrenceCount) calculateLikelihood :: [LanguageConfiguration] -> TermResults -> TermResults calculateLikelihood lcs r = r { trRemoval = uncurry Removal newLikelihood } where- baseScore = totalOccurrenceCount r- totalScore = baseScore newLikelihood- | isJust firstAutoLowLikelihood = (Low, autoLowLikelihoodMessage)+ | M.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 < 2 = (High, "occurs 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+ totalScore = totalOccurrenceCount r+ firstAutoLowLikelihood = L.find (`RF.autoLowLikelihood` r) lcs+ autoLowLikelihoodMessage = maybe "" languageConfirmationMessage firstAutoLowLikelihood languageConfirmationMessage :: LanguageConfiguration -> String languageConfirmationMessage lc = langFramework ++ ": allowed term or " ++ lowLikelihoodNames where langFramework = lcName lc- lowLikelihoodNames = intercalate ", " $ map smName $ lcAutoLowLikelihood lc+ lowLikelihoodNames = L.intercalate ", " $ map smName $ lcAutoLowLikelihood lc singleNonTestUsage :: TermResults -> Bool singleNonTestUsage = (1 ==) . oOccurrences . trAppOccurrences
src/Unused/Parser.hs view
@@ -2,25 +2,23 @@ ( parseResults ) where -import Data.Bifunctor (second)-import Control.Arrow ((&&&))+import Control.Arrow ((&&&))+import qualified Data.Bifunctor as BF+import qualified Data.List as L 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+import Unused.Aliases (groupedTermsAndAliases)+import Unused.LikelihoodCalculator (calculateLikelihood)+import Unused.ResultsClassifier.Types (LanguageConfiguration(..))+import Unused.TermSearch (SearchResults, fromResults)+import Unused.Types (TermMatchSet, TermMatch, resultsFromMatches, tmDisplayTerm) parseResults :: [LanguageConfiguration] -> SearchResults -> TermMatchSet parseResults lcs =- Map.fromList . map (second $ calculateLikelihood lcs . resultsFromMatches) . groupResults aliases . fromResults- where- aliases = concatMap lcTermAliases lcs+ Map.fromList . map (BF.second $ calculateLikelihood lcs . resultsFromMatches) . groupResults . fromResults -groupResults :: [TermAlias] -> [TermMatch] -> [(String, [TermMatch])]-groupResults aliases ms =+groupResults :: [TermMatch] -> [(String, [TermMatch])]+groupResults ms = map (toKey &&& id) groupedMatches where- toKey = intercalate "|" . nub . sort . map tmTerm- groupedMatches = groupedTermsAndAliases aliases ms+ toKey = L.intercalate "|" . L.nub . L.sort . map tmDisplayTerm+ groupedMatches = groupedTermsAndAliases ms
+ src/Unused/Projection.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}++module Unused.Projection where++import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec+import Text.Megaparsec.Text+import Unused.Projection.Transform++data ParsedTransform = ParsedTransform+ { ptPre :: Text+ , ptTransforms :: [Transform]+ , ptPost :: Text+ }++translate :: Text -> Either ParseError (Text -> Text)+translate template = applyTransform <$> parseTransform template++applyTransform :: ParsedTransform -> Text -> Text+applyTransform pt t =+ ptPre pt+ <> runTransformations t (ptTransforms pt)+ <> ptPost pt++parseTransform :: Text -> Either ParseError ParsedTransform+parseTransform = parse parsedTransformParser ""++parsedTransformParser :: Parser ParsedTransform+parsedTransformParser =+ ParsedTransform+ <$> preTransformsParser+ <*> transformsParser+ <*> postTransformsParser++preTransformsParser :: Parser Text+preTransformsParser = T.pack <$> manyTill anyChar (char '{')++transformsParser :: Parser [Transform]+transformsParser = transformParser `sepBy` char '|' <* char '}'++postTransformsParser :: Parser Text+postTransformsParser = T.pack <$> many anyChar++transformParser :: Parser Transform+transformParser = do+ result <- string "camelcase" <|> string "snakecase"+ return $ case result of+ "camelcase" -> Camelcase+ "snakecase" -> Snakecase+ _ -> Noop
+ src/Unused/Projection/Transform.hs view
@@ -0,0 +1,37 @@+module Unused.Projection.Transform+ ( Transform(..)+ , runTransformations+ ) where++import Data.Either (rights)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Text.Inflections as I+import qualified Text.Inflections.Parse.Types as I+import qualified Unused.Util as U++data Transform+ = Camelcase+ | Snakecase+ | Noop++runTransformations :: Text -> [Transform] -> Text+runTransformations = foldl (flip runTransformation)++runTransformation :: Transform -> Text -> Text+runTransformation Camelcase = toCamelcase+runTransformation Snakecase = toSnakecase+runTransformation Noop = id++toCamelcase :: Text -> Text+toCamelcase t = maybe t (T.pack . I.camelize) $ toMaybeWords t++toSnakecase :: Text -> Text+toSnakecase t = maybe t (T.pack . I.underscore) $ toMaybeWords t++toMaybeWords :: Text -> Maybe [I.Word]+toMaybeWords t =+ U.safeHead $ rights [asCamel, asSnake]+ where+ asCamel = I.parseCamelCase [] $ T.unpack t+ asSnake = I.parseSnakeCase [] $ T.unpack t
src/Unused/ResponseFilter.hs view
@@ -8,11 +8,11 @@ , 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+import qualified Data.List as L+import qualified Data.Map.Strict as Map+import Unused.ResultsClassifier (Position(..), Matcher(..), LanguageConfiguration(..), LowLikelihoodMatch(..))+import Unused.Types (TermResults(..), TermMatchSet, TermMatch(..), RemovalLikelihood, Removal(..), totalOccurrenceCount, appOccurrenceCount) withOneOccurrence :: TermMatchSet -> TermMatchSet withOneOccurrence = Map.filterWithKey (const oneOccurence)@@ -29,7 +29,7 @@ updateMatches newMatches where newMatches = filter (not . matchesPath . tmPath)- matchesPath p = any (`isInfixOf` p) xs+ matchesPath p = any (`L.isInfixOf` p) xs includesLikelihood :: [RemovalLikelihood] -> TermResults -> Bool includesLikelihood l = (`elem` l) . rLikelihood . trRemoval@@ -65,12 +65,12 @@ matcherToBool (AllowedTerms ts) = (`isAllowedTerm` ts) positionToTest :: Position -> (String -> String -> Bool)-positionToTest StartsWith = isPrefixOf-positionToTest EndsWith = isSuffixOf+positionToTest StartsWith = L.isPrefixOf+positionToTest EndsWith = L.isSuffixOf positionToTest Equals = (==) paths :: TermResults -> [String]-paths r = tmPath <$> trMatches r+paths = fmap tmPath . trMatches updateMatches :: ([TermMatch] -> [TermMatch]) -> TermMatchSet -> TermMatchSet updateMatches fm =
src/Unused/ResultsClassifier.hs view
@@ -2,5 +2,5 @@ ( module X ) where -import Unused.ResultsClassifier.Types as X import Unused.ResultsClassifier.Config as X+import Unused.ResultsClassifier.Types as X
src/Unused/ResultsClassifier/Config.hs view
@@ -3,23 +3,27 @@ , loadAllConfigurations ) where -import qualified Data.Yaml as Y-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C+import qualified Data.Bifunctor as BF 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)+import qualified Data.Yaml as Y+import qualified Paths_unused as Paths+import qualified System.Directory as D+import System.FilePath ((</>))+import Unused.ResultsClassifier.Types (LanguageConfiguration, ParseConfigError(..))+import Unused.Util (safeReadFile) loadConfig :: IO (Either String [LanguageConfiguration])-loadConfig = Y.decodeEither <$> readConfig+loadConfig = do+ configFileName <- Paths.getDataFileName ("data" </> "config.yml") + either+ (const $ Left "default config not found")+ Y.decodeEither+ <$> safeReadFile configFileName+ loadAllConfigurations :: IO (Either [ParseConfigError] [LanguageConfiguration]) loadAllConfigurations = do- homeDir <- getHomeDirectory+ homeDir <- D.getHomeDirectory defaultConfig <- addSourceToLeft "default config" <$> loadConfig localConfig <- loadConfigFromFile ".unused.yml"@@ -27,19 +31,16 @@ let (lefts, rights) = E.partitionEithers [defaultConfig, localConfig, userConfig] - if not (null lefts)- then return $ Left lefts- else return $ Right $ concat rights+ return $ if not (null lefts)+ then Left lefts+ else 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+loadConfigFromFile path =+ either+ (const $ Right [])+ (addSourceToLeft path . Y.decodeEither)+ <$> safeReadFile path 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+addSourceToLeft = BF.first . ParseConfigError
src/Unused/ResultsClassifier/Types.hs view
@@ -10,39 +10,42 @@ , ParseConfigError(..) ) where -import Control.Monad (mzero)+import qualified Control.Applicative as A+import qualified Control.Monad as M+import qualified Data.HashMap.Strict as HM+import qualified Data.List as L import qualified Data.Text as T+import Data.Text (Text)+import Data.Yaml (FromJSON(..), (.:), (.:?), (.!=)) 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(..), (.:), (.:?), (.!=))+import Unused.Projection 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+ , taTransform :: Text -> Text+ } 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+data Position = StartsWith | EndsWith | Equals+data Matcher = Term Position String | Path Position String | AppOccurrences Int | AllowedTerms [String] instance FromJSON LanguageConfiguration where parseJSON (Y.Object o) = LanguageConfiguration@@ -50,20 +53,21 @@ <*> o .:? "allowedTerms" .!= [] <*> o .:? "autoLowLikelihood" .!= [] <*> o .:? "aliases" .!= []- parseJSON _ = mzero+ parseJSON _ = M.mzero instance FromJSON LowLikelihoodMatch where parseJSON (Y.Object o) = LowLikelihoodMatch <$> o .: "name" <*> parseMatchers o <*> o .:? "classOrModule" .!= False- parseJSON _ = mzero+ parseJSON _ = M.mzero instance FromJSON TermAlias where parseJSON (Y.Object o) = TermAlias <$> o .: "from" <*> o .: "to"- parseJSON _ = mzero+ <*> (either (fail . show) return =<< (translate . T.pack <$> (o .: "to")))+ parseJSON _ = M.mzero data MatchHandler a = MatchHandler { mhKeys :: [String]@@ -112,7 +116,7 @@ else fail $ "The following keys are unsupported: " ++ L.intercalate ", " (T.unpack <$> unsupportedKeys) where fullOverlap = null unsupportedKeys- unsupportedKeys = keys o L.\\ lowLikelihoodMatchKeys+ unsupportedKeys = HM.keys o L.\\ lowLikelihoodMatchKeys parseMatchers :: Y.Object -> Y.Parser [Matcher] parseMatchers o =@@ -130,13 +134,13 @@ mKey = (.:?) o positionKeysforMatcher :: Y.Object -> [String] -> [T.Text]-positionKeysforMatcher o ls = L.intersect (T.pack <$> ls) $ keys o+positionKeysforMatcher o ls = L.intersect (T.pack <$> ls) $ HM.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+convertFoundObjectToMatcher :: (Monad m, A.Alternative m) => m (Maybe a) -> (a -> b) -> m b+convertFoundObjectToMatcher p f = maybe A.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
@@ -6,12 +6,16 @@ , loadTagsFromPipe ) where -import Data.List (isPrefixOf, nub)-import System.Directory (findFile)+import qualified Control.Exception as E+import qualified Data.Bifunctor as BF+import qualified Data.List as L import qualified Data.Text as T+import qualified System.Directory as D+import Unused.Util (safeReadFile) data TagSearchOutcome = TagsFileNotFound [String]+ | IOError E.IOException loadTagsFromPipe :: IO (Either TagSearchOutcome [String]) loadTagsFromPipe = fmap (Right . tokensFromTags) getContents@@ -21,20 +25,20 @@ tokensFromTags :: String -> [String] tokensFromTags =- filter validTokens . nub . tokenLocations+ filter validTokens . L.nub . tokenLocations where tokenLocations = map (token . T.splitOn "\t" . T.pack) . lines token = T.unpack . head validTokens :: String -> Bool-validTokens = not . isPrefixOf "!_TAG"+validTokens = not . L.isPrefixOf "!_TAG" tagsContent :: IO (Either TagSearchOutcome String)-tagsContent = findFile possibleTagsFileDirectories "tags" >>= eitherReadFile+tagsContent = D.findFile possibleTagsFileDirectories "tags" >>= eitherReadFile eitherReadFile :: Maybe String -> IO (Either TagSearchOutcome String) eitherReadFile Nothing = return $ Left $ TagsFileNotFound possibleTagsFileDirectories-eitherReadFile (Just path) = Right <$> readFile path+eitherReadFile (Just path) = BF.first IOError <$> safeReadFile path possibleTagsFileDirectories :: [String] possibleTagsFileDirectories = [".git", "tmp", "."]
src/Unused/TermSearch.hs view
@@ -1,20 +1,20 @@ module Unused.TermSearch ( SearchResults(..)- , fromResults+ , SearchTerm , search ) where -import System.Process-import Data.Maybe (mapMaybe)-import Unused.TermSearch.Types-import Unused.TermSearch.Internal+import qualified Data.Maybe as M+import qualified System.Process as P+import Unused.TermSearch.Internal (commandLineOptions, parseSearchResult)+import Unused.TermSearch.Types (SearchResults(..))+import Unused.Types (SearchTerm, searchTermToString) -search :: String -> IO SearchResults-search t = do- results <- lines <$> ag t- return $ SearchResults $ mapMaybe (parseSearchResult t) results+search :: SearchTerm -> IO SearchResults+search t =+ SearchResults . M.mapMaybe (parseSearchResult t) <$> (lines <$> ag (searchTermToString t)) ag :: String -> IO String ag t = do- (_, results, _) <- readProcessWithExitCode "ag" (commandLineOptions t) ""+ (_, results, _) <- P.readProcessWithExitCode "ag" (commandLineOptions t) "" return results
src/Unused/TermSearch/Internal.hs view
@@ -5,11 +5,11 @@ , 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)+import qualified Data.Maybe as M+import qualified Data.Text as T+import Unused.Types (SearchTerm(..), TermMatch(..))+import Unused.Util (stringToInt) commandLineOptions :: String -> [String] commandLineOptions t =@@ -19,16 +19,15 @@ 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+parseSearchResult :: SearchTerm -> String -> Maybe TermMatch+parseSearchResult term =+ maybeTermMatch . map T.unpack . T.splitOn ":" . T.pack where- toTermMatch [_, path, count] = Just $ TermMatch term path (countInt count)- toTermMatch _ = Nothing- countInt = fromMaybe 0 . stringToInt+ maybeTermMatch [_, path, count] = Just $ toTermMatch term path $ countInt count+ maybeTermMatch _ = Nothing+ countInt = M.fromMaybe 0 . stringToInt+ toTermMatch (OriginalTerm t) path = TermMatch t path Nothing+ toTermMatch (AliasTerm t a) path = TermMatch t path (Just a) regexSafeTerm :: String -> Bool-regexSafeTerm =- all regexSafeChar- where- regexSafeChar c = C.isAlphaNum c || c == '_' || c == '-'+regexSafeTerm = all (\c -> C.isAlphaNum c || c == '_' || c == '-')
src/Unused/TermSearch/Types.hs view
@@ -2,12 +2,8 @@ module Unused.TermSearch.Types ( SearchResults(..)- , fromResults ) where import Unused.Types (TermMatch) -newtype SearchResults = SearchResults [TermMatch] deriving (Monoid)--fromResults :: SearchResults -> [TermMatch]-fromResults (SearchResults a) = a+newtype SearchResults = SearchResults { fromResults :: [TermMatch] } deriving (Monoid)
src/Unused/Types.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE DeriveGeneric #-} module Unused.Types- ( TermMatch(..)+ ( SearchTerm(..)+ , TermMatch(..) , TermResults(..) , TermMatchSet , RemovalLikelihood(..)@@ -9,7 +10,9 @@ , Occurrences(..) , GitContext(..) , GitCommit(..)+ , searchTermToString , resultsFromMatches+ , tmDisplayTerm , totalFileCount , totalOccurrenceCount , appOccurrenceCount@@ -17,17 +20,28 @@ , resultAliases ) where -import qualified Data.Map.Strict as Map-import Data.Csv+import Control.Monad (liftM2)+import Data.Csv (FromRecord, ToRecord) import qualified Data.List as L-import GHC.Generics-import Unused.Regex+import qualified Data.Maybe as M+import qualified Data.Map.Strict as Map+import qualified GHC.Generics as G+import qualified Unused.Regex as R +data SearchTerm+ = OriginalTerm String+ | AliasTerm String String deriving (Eq, Show)++searchTermToString :: SearchTerm -> String+searchTermToString (OriginalTerm s) = s+searchTermToString (AliasTerm _ a) = a+ data TermMatch = TermMatch { tmTerm :: String , tmPath :: String+ , tmAlias :: Maybe String , tmOccurrences :: Int- } deriving (Eq, Show, Generic)+ } deriving (Eq, Show, G.Generic) instance FromRecord TermMatch instance ToRecord TermMatch@@ -80,12 +94,15 @@ resultAliases :: TermResults -> [String] resultAliases = trTerms +tmDisplayTerm :: TermMatch -> String+tmDisplayTerm = liftM2 M.fromMaybe tmTerm tmAlias+ resultsFromMatches :: [TermMatch] -> TermResults-resultsFromMatches m =+resultsFromMatches tms = TermResults { trTerm = resultTerm terms , trTerms = L.sort $ L.nub terms- , trMatches = m+ , trMatches = tms , trAppOccurrences = appOccurrence , trTestOccurrences = testOccurrence , trTotalOccurrences = Occurrences (sum $ map oFiles [appOccurrence, testOccurrence]) (sum $ map oOccurrences [appOccurrence, testOccurrence])@@ -93,9 +110,9 @@ , trGitContext = Nothing } where- testOccurrence = testOccurrences m- appOccurrence = appOccurrences m- terms = map tmTerm m+ testOccurrence = testOccurrences tms+ appOccurrence = appOccurrences tms+ terms = map tmDisplayTerm tms resultTerm (x:_) = x resultTerm _ = "" @@ -103,7 +120,7 @@ appOccurrences ms = Occurrences appFiles appOccurrences' where- totalFiles = length ms+ totalFiles = length $ L.nub $ map tmPath ms totalOccurrences = sum $ map tmOccurrences ms tests = testOccurrences ms appFiles = totalFiles - oFiles tests@@ -114,20 +131,18 @@ Occurrences totalFiles totalOccurrences where testMatches = filter termMatchIsTest ms- totalFiles = length testMatches+ totalFiles = length $ L.nub $ map tmPath testMatches totalOccurrences = sum $ map tmOccurrences testMatches testDir :: String -> Bool-testDir = matchRegex "(spec|tests?|features)\\/"+testDir = R.matchRegex "(spec|tests?|features)\\/" testSnakeCaseFilename :: String -> Bool-testSnakeCaseFilename = matchRegex ".*(_spec|_test)\\."+testSnakeCaseFilename = R.matchRegex ".*(_spec|_test)\\." testCamelCaseFilename :: String -> Bool-testCamelCaseFilename = matchRegex ".*(Spec|Test)\\."+testCamelCaseFilename = R.matchRegex ".*(Spec|Test)\\." termMatchIsTest :: TermMatch -> Bool-termMatchIsTest m =+termMatchIsTest TermMatch{tmPath = path} = testDir path || testSnakeCaseFilename path || testCamelCaseFilename path- where- path = tmPath m
src/Unused/Util.hs view
@@ -1,15 +1,20 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+ module Unused.Util ( groupBy , stringToInt , safeHead- , readIfFileExists+ , safeReadFile ) where -import System.Directory (doesFileExist)-import Control.Arrow ((&&&))+import Control.Arrow ((&&&))+import qualified Control.Exception as E+import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Lazy.Char8 as Cl8+import qualified Data.Char as C+import Data.Function (on) 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)@@ -22,15 +27,22 @@ stringToInt :: String -> Maybe Int stringToInt xs- | all isDigit xs = Just $ loop 0 xs+ | all C.isDigit xs = Just $ loop 0 xs | otherwise = Nothing where- loop = foldl (\acc x -> acc * 10 + digitToInt x)+ loop = foldl (\acc x -> acc * 10 + C.digitToInt x) -readIfFileExists :: String -> IO (Maybe String)-readIfFileExists path = do- exists <- doesFileExist path+class Readable a where+ readFile' :: FilePath -> IO a - if exists- then Just <$> readFile path- else return Nothing+instance Readable String where+ readFile' = readFile++instance Readable C8.ByteString where+ readFile' = C8.readFile++instance Readable Cl8.ByteString where+ readFile' = Cl8.readFile++safeReadFile :: Readable s => FilePath -> IO (Either E.IOException s)+safeReadFile = E.try . readFile'
test/Unused/AliasesSpec.hs view
@@ -1,8 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+ module Unused.AliasesSpec where +import Data.Monoid ((<>)) import Test.Hspec import Unused.Aliases import Unused.ResultsClassifier.Types (TermAlias(..))+import Unused.Types (SearchTerm(..)) main :: IO () main = hspec spec@@ -11,11 +15,11 @@ spec = parallel $ describe "termsAndAliases" $ do it "returns the terms if no aliases are provided" $- termsAndAliases [] ["method_1", "method_2"] `shouldBe` ["method_1", "method_2"]+ termsAndAliases [] ["method_1", "method_2"] `shouldBe` [OriginalTerm "method_1", OriginalTerm "method_2"] it "adds aliases to the list of terms" $ do- let predicateAlias = TermAlias "%s?" "be_%s"- let pluralizeAlias = TermAlias "really_%s" "very_%s"+ let predicateAlias = TermAlias "*?" "be_{}" ("be_" <>)+ let pluralizeAlias = TermAlias "really_*" "very_{}" ("very_" <>) termsAndAliases [predicateAlias, pluralizeAlias] ["awesome?", "really_cool"]- `shouldBe` ["awesome?", "be_awesome", "really_cool", "very_cool"]+ `shouldBe` [OriginalTerm "awesome?", AliasTerm "awesome?" "be_awesome", OriginalTerm "really_cool", AliasTerm "really_cool" "very_cool"]
test/Unused/Grouping/InternalSpec.hs view
@@ -4,9 +4,9 @@ ) where import Test.Hspec-import Unused.Types import Unused.Grouping.Internal import Unused.Grouping.Types+import Unused.Types main :: IO () main = hspec spec@@ -15,21 +15,21 @@ spec = parallel $ describe "groupFilter" $ do it "groups by directory" $ do- let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" Nothing 10 groupFilter GroupByDirectory termMatch `shouldBe` ByDirectory "foo/bar" it "groups by term" $ do- let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" Nothing 10 groupFilter GroupByTerm termMatch `shouldBe` ByTerm "AwesomeClass" it "groups by file" $ do- let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" Nothing 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+ let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" Nothing 10 groupFilter NoGroup termMatch `shouldBe` NoGrouping
test/Unused/LikelihoodCalculatorSpec.hs view
@@ -4,9 +4,9 @@ ) where import Test.Hspec-import Unused.Types import Unused.LikelihoodCalculator import Unused.ResultsClassifier+import Unused.Types main :: IO () main = hspec spec@@ -15,44 +15,44 @@ spec = parallel $ describe "calculateLikelihood" $ do it "prefers language-specific checks first" $ do- let railsMatches = [ TermMatch "ApplicationController" "app/controllers/application_controller.rb" 1 ]+ let railsMatches = [ TermMatch "ApplicationController" "app/controllers/application_controller.rb" Nothing 1 ] removalLikelihood' railsMatches `shouldReturn` Low - let elixirMatches = [ TermMatch "AwesomeView" "web/views/awesome_view.ex" 1 ]+ let elixirMatches = [ TermMatch "AwesomeView" "web/views/awesome_view.ex" Nothing 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+ let matches = [ TermMatch "full_name" "app/models/user.rb" Nothing 4+ , TermMatch "full_name" "app/views/application/_auth_header.rb" Nothing 1+ , TermMatch "full_name" "app/mailers/user_mailer.rb" Nothing 1+ , TermMatch "full_name" "spec/models/user_spec.rb" Nothing 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 ]+ it "weighs only-occurs-once methods as high likelihood" $ do+ let matches = [ TermMatch "obscure_method" "app/models/user.rb" Nothing 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+ let matches = [ TermMatch "obscure_method" "app/models/user.rb" Nothing 1+ , TermMatch "obscure_method" "spec/models/user_spec.rb" Nothing 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+ let matches = [ TermMatch "obscure_method" "app/models/user.rb" Nothing 1+ , TermMatch "obscure_method" "app/controllers/user_controller.rb" Nothing 1+ , TermMatch "obscure_method" "spec/models/user_spec.rb" Nothing 5+ , TermMatch "obscure_method" "spec/controllers/user_controller_spec.rb" Nothing 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 ]+ let matches = [ TermMatch "t" "web/models/foo.ex" Nothing 1 ] removalLikelihood' matches `shouldReturn` High
test/Unused/ParserSpec.hs view
@@ -1,11 +1,11 @@ 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+import Test.Hspec+import Unused.Parser+import Unused.ResultsClassifier+import Unused.TermSearch+import Unused.Types main :: IO () main = hspec spec@@ -14,14 +14,14 @@ 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 r1Matches = [ TermMatch "method_name" "app/path/foo.rb" Nothing 1+ , TermMatch "method_name" "app/path/other.rb" Nothing 5+ , TermMatch "method_name" "spec/path/foo_spec.rb" Nothing 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+ let r2Matches = [ TermMatch "other" "app/path/other.rb" Nothing 1 ]+ let r2Results = TermResults "other" ["other"] r2Matches (Occurrences 0 0) (Occurrences 1 1) (Occurrences 1 1) (Removal High "occurs once") Nothing (Right config) <- loadConfig @@ -31,9 +31,9 @@ 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 r1Matches = [ TermMatch "method_name" "app/path/foo.rb" Nothing 1+ , TermMatch "method_name" "app/path/other.rb" Nothing 5+ , TermMatch "method_name" "spec/path/foo_spec.rb" Nothing 10 ] let r1Results = TermResults "method_name" ["method_name"] r1Matches (Occurrences 1 10) (Occurrences 2 6) (Occurrences 3 16) (Removal Low "used frequently") Nothing @@ -43,10 +43,10 @@ Map.fromList [ ("method_name", r1Results) ] it "handles aliases correctly" $ do- let r1Matches = [ TermMatch "admin?" "app/path/user.rb" 3 ]+ let r1Matches = [ TermMatch "admin?" "app/path/user.rb" Nothing 3 ] - let r2Matches = [ TermMatch "be_admin" "spec/models/user_spec.rb" 2- , TermMatch "be_admin" "spec/features/user_promoted_to_admin_spec.rb" 2+ let r2Matches = [ TermMatch "admin?" "spec/models/user_spec.rb" (Just "be_admin") 2+ , TermMatch "admin?" "spec/features/user_promoted_to_admin_spec.rb" (Just "be_admin") 2 ]
test/Unused/ResponseFilterSpec.hs view
@@ -3,11 +3,11 @@ , spec ) where -import Test.Hspec import Data.List (find)-import Unused.Types (TermMatch(..), TermResults, resultsFromMatches)+import Test.Hspec import Unused.ResponseFilter import Unused.ResultsClassifier+import Unused.Types (TermMatch(..), TermResults, resultsFromMatches) main :: IO () main = hspec spec@@ -16,121 +16,121 @@ spec = parallel $ do describe "railsAutoLowLikelihood" $ do it "allows controllers" $ do- let match = TermMatch "ApplicationController" "app/controllers/application_controller.rb" 1+ let match = TermMatch "ApplicationController" "app/controllers/application_controller.rb" Nothing 1 let result = resultsFromMatches [match] railsAutoLowLikelihood result `shouldReturn` True it "allows helpers" $ do- let match = TermMatch "ApplicationHelper" "app/helpers/application_helper.rb" 1+ let match = TermMatch "ApplicationHelper" "app/helpers/application_helper.rb" Nothing 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 match = TermMatch "CreateUsers" "db/migrate/20160101120000_create_users.rb" Nothing 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 match = TermMatch "CreatePostWithNotifications" "app/services/create_post_with_notifications.rb" Nothing 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 match = TermMatch "my_method" "app/services/create_post_with_notifications.rb" Nothing 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 model = TermMatch "User" "app/models/user.rb" Nothing 1+ let migration = TermMatch "User" "db/migrate/20160101120000_create_users.rb" Nothing 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 appToken = TermMatch "ApplicationHelper" "app/helpers/application_helper.rb" Nothing 1+ let testToken = TermMatch "ApplicationHelper" "spec/helpers/application_helper_spec.rb" Nothing 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 match = TermMatch "PageController" "web/controllers/page_controller.rb" Nothing 1 let result = resultsFromMatches [match] elixirAutoLowLikelihood result `shouldReturn` False it "allows views" $ do- let match = TermMatch "PageView" "web/views/page_view.rb" 1+ let match = TermMatch "PageView" "web/views/page_view.rb" Nothing 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 match = TermMatch "CreateUsers" "priv/repo/migrations/20160101120000_create_users.exs" Nothing 1 let result = resultsFromMatches [match] elixirAutoLowLikelihood result `shouldReturn` True it "allows tests" $ do- let match = TermMatch "UserTest" "test/models/user_test.exs" 1+ let match = TermMatch "UserTest" "test/models/user_test.exs" Nothing 1 let result = resultsFromMatches [match] elixirAutoLowLikelihood result `shouldReturn` True it "allows Mixfile" $ do- let match = TermMatch "Mixfile" "mix.exs" 1+ let match = TermMatch "Mixfile" "mix.exs" Nothing 1 let result = resultsFromMatches [match] elixirAutoLowLikelihood result `shouldReturn` True it "allows __using__" $ do- let match = TermMatch "__using__" "web/web.ex" 1+ let match = TermMatch "__using__" "web/web.ex" Nothing 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 match = TermMatch "CreatePostWithNotifications" "web/services/create_post_with_notifications.ex" Nothing 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 match = TermMatch "my_function" "web/services/create_post_with_notifications.ex" Nothing 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 appToken = TermMatch "UserView" "web/views/user_view.ex" Nothing 1+ let testToken = TermMatch "UserView" "test/views/user_view_test.exs" Nothing 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 match = TermMatch "instance" "src/Lib/Types.hs" Nothing 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 match = TermMatch "Lib.SomethingSpec" "lib.cabal" Nothing 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 match = TermMatch "AwesomeThing" "app/foo/awesome_thing.rb" Nothing 1 let result = resultsFromMatches [match] let languageConfig = LanguageConfiguration "Bad" [] [LowLikelihoodMatch "Match with empty matchers" [] False] []
test/Unused/TermSearch/InternalSpec.hs view
@@ -4,8 +4,8 @@ ) where import Test.Hspec-import Unused.Types import Unused.TermSearch.Internal+import Unused.Types main :: IO () main = hspec spec@@ -24,7 +24,7 @@ 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)+ parseSearchResult (OriginalTerm "method_name") ":app/models/foo.rb:123" `shouldBe` (Just $ TermMatch "method_name" "app/models/foo.rb" Nothing 123) it "returns Nothing when it cannot parse" $- parseSearchResult "method_name" "" `shouldBe` Nothing+ parseSearchResult (OriginalTerm "method_name") "" `shouldBe` Nothing
test/Unused/TypesSpec.hs view
@@ -10,8 +10,8 @@ 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+ let matches = [ TermMatch "ApplicationController" "app/controllers/application_controller.rb" Nothing 1+ , TermMatch "ApplicationController" "spec/controllers/application_controller_spec.rb" Nothing 10 ] resultsFromMatches matches `shouldBe`
unused.cabal view
@@ -1,5 +1,5 @@ name: unused-version: 0.5.0.2+version: 0.6.0.0 synopsis: A command line tool to identify unused code. description: Please see README.md homepage: https://github.com/joshuaclayton/unused#readme@@ -25,6 +25,8 @@ , Unused.Util , Unused.Regex , Unused.Aliases+ , Unused.Projection+ , Unused.Projection.Transform , Unused.ResponseFilter , Unused.ResultsClassifier , Unused.ResultsClassifier.Types@@ -77,6 +79,8 @@ , vector , mtl , transformers+ , megaparsec+ , inflections ghc-options: -Wall default-language: Haskell2010 @@ -100,6 +104,7 @@ , unused , hspec , containers+ , text other-modules: Unused.ParserSpec , Unused.ResponseFilterSpec , Unused.TypesSpec