Initial pass at RemovalLikelihood calculator

app/Main.hs

@@ -96,16 +96,18 @@ printDirectory (DirectoryPrefix dir) = do
     setSGR   [Reset]
 
 printTermResults :: Int -> (String, TermResults) -> IO ()
-printTermResults w (_, results) = do
+printTermResults w (_, results) =
     printMatches w results $ matches results
 
+likelihoodColor :: RemovalLikelihood -> Color
+likelihoodColor High = Red
+likelihoodColor Medium = Yellow
+likelihoodColor Low = Green
+
 printMatches :: Int -> TermResults -> [TermMatch] -> IO ()
-printMatches w _r ms = do
-    mapM_ printMatch ms
-  where
-    termFormat = "%-" ++ (show w) ++ "s"
-    printMatch m = do
-        setSGR [SetColor Foreground Dull Red]
+printMatches w r ms =
+    forM_ ms $ \m -> do
+        setSGR [SetColor Foreground Dull (likelihoodColor $ removalLikelihood r)]
         setSGR [SetConsoleIntensity NormalIntensity]
         putStr $ "     " ++ (printf termFormat $ term m)
         setSGR [Reset]
@@ -114,6 +116,8 @@ printMatches w _r ms = do
         putStr $ "  " ++ path m
         setSGR [Reset]
         putStr "\n"
+  where
+    termFormat = "%-" ++ (show w) ++ "s"
 
 printParseError :: ParseError -> IO ()
 printParseError e = do

src/Unused/Regex.hs

@@ -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/Types.hs

@@ -4,6 +4,7 @@ module Unused.Types
     , TermMatchSet
     , ParseResponse
     , DirectoryPrefix(..)
+    , RemovalLikelihood(..)
     , listFromMatchSet
     , withOneFile
     , withOneOccurrence
@@ -16,6 +17,7 @@ import Text.Parsec (ParseError)
 import Data.Bifunctor (second)
 import Data.List (intercalate, sort, nub)
 import qualified Data.Map.Strict as Map
+import Unused.Regex (matchRegex)
 
 data TermMatch = TermMatch
     { term :: String
@@ -24,11 +26,15 @@ data TermMatch = TermMatch
     } deriving Show
 
 data TermResults = TermResults
-    { matches :: [TermMatch]
+    { resultTerm :: String
+    , matches :: [TermMatch]
     , totalFiles :: Int
     , totalOccurrences :: Int
+    , removalLikelihood :: RemovalLikelihood
     } deriving Show
 
+data RemovalLikelihood = High | Medium | Low deriving Show
+
 type TermMatchSet = Map.Map String TermResults
 
 type ParseResponse = Either ParseError TermMatchSet
@@ -37,20 +43,56 @@ newtype DirectoryPrefix = DirectoryPrefix String deriving (Eq, Show, Ord)
 
 resultsFromMatches :: [TermMatch] -> TermResults
 resultsFromMatches m =
-    TermResults
-        { matches = m
+    calculateLikelihood $ TermResults
+        { resultTerm = resultTerm' terms
+        , matches = m
         , totalFiles = totalFiles'
         , totalOccurrences = totalOccurrences'
+        , removalLikelihood = High
         }
   where
     totalFiles' = length m
     totalOccurrences' = sum $ fmap occurrences m
+    terms = map term m
+    resultTerm' (x:_) = x
+    resultTerm' _ = ""
 
 withOneFile :: ParseResponse -> ParseResponse
-withOneFile = fmap $ Map.filterWithKey (const $ ((==) 1) . totalFiles)
+withOneFile = fmap $ Map.filterWithKey (const oneFile)
 
 withOneOccurrence :: ParseResponse -> ParseResponse
-withOneOccurrence = fmap $ Map.filterWithKey (const $ ((==) 1 ) . totalOccurrences)
+withOneOccurrence = fmap $ Map.filterWithKey (const oneOccurence)
+
+oneOccurence :: TermResults -> Bool
+oneOccurence = (== 1) . totalOccurrences
+
+oneFile :: TermResults -> Bool
+oneFile = (== 1) . totalFiles
+
+isClassOrModule :: TermResults -> Bool
+isClassOrModule = matchRegex "^[A-Z]" . resultTerm
+
+railsSingleOkay :: TermResults -> Bool
+railsSingleOkay r =
+    foldl1 (&&) [isClassOrModule r, oneFile r, oneOccurence r, (controller || helper || migration)]
+  where
+    controller = (matchRegex "^app/controllers/" singlePath) && (matchRegex "Controller$" $ resultTerm r)
+    helper = (matchRegex "^app/helpers/" singlePath) && (matchRegex "Helper$" $ resultTerm r)
+    migration = matchRegex "^db/migrate/" singlePath
+    singlePath = path' $ fmap path $ matches r
+    path' (x:_) = x
+    path' [] = ""
+
+elixirSingleOkay :: TermResults -> Bool
+elixirSingleOkay r =
+    foldl1 (&&) [isClassOrModule r, oneFile r, oneOccurence r, (view || test || migration)]
+  where
+    migration = matchRegex "^priv/repo/migrations/" singlePath
+    view = (matchRegex "^web/views/" singlePath) && (matchRegex "View$" $ resultTerm r)
+    test = (matchRegex "^test/" singlePath) && (matchRegex "Test$" $ resultTerm r)
+    singlePath = path' $ fmap path $ matches r
+    path' (x:_) = x
+    path' [] = ""
 
 listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
 listFromMatchSet =
@@ -79,3 +121,17 @@ directoriesForGrouping =
     uniqueValues . Map.map (fmap (fileNameGrouping . path) . matches)
   where
     uniqueValues = sort . nub . concat . Map.elems
+
+calculateLikelihood :: TermResults -> TermResults
+calculateLikelihood r =
+    r { removalLikelihood = newLikelihood }
+  where
+    baseScore = totalOccurrences r
+    railsScore = if railsSingleOkay r then 5 else 0
+    elixirScore = if elixirSingleOkay r then 5 else 0
+    totalScore = baseScore + railsScore + elixirScore
+    newLikelihood
+        | totalScore < 3 = High
+        | totalScore < 6 = Medium
+        | totalScore < 9 = Low
+        | otherwise = Low

unused.cabal

@@ -19,11 +19,13 @@ library
                      , Unused.Parser
                      , Unused.Types
                      , Unused.Util
+                     , Unused.Regex
   build-depends:       base >= 4.7 && < 5
                      , process
                      , parsec
                      , containers
                      , filepath
+                     , regex-tdfa
   default-language:    Haskell2010
 
 executable unused