mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Initial pass at RemovalLikelihood calculator
This commit is contained in:
parent
02f90fdb7d
commit
67e52ed017
18
app/Main.hs
18
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
|
||||
|
13
src/Unused/Regex.hs
Normal file
13
src/Unused/Regex.hs
Normal file
@ -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
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user