From 1f5db58f5e2ae146045ec4f3956c4c9a7b89d35a Mon Sep 17 00:00:00 2001 From: Joshua Clayton Date: Sat, 7 May 2016 05:56:46 -0400 Subject: [PATCH] Move additional functionality out of Types and into separate modules --- app/Main.hs | 2 +- src/Unused/CLI/SearchResult.hs | 6 ++ src/Unused/DirectoryGrouping.hs | 37 ++++++++++ src/Unused/LikelihoodCalculator.hs | 20 ++++++ src/Unused/Parser.hs | 19 ++++- src/Unused/ResponseFilter.hs | 53 ++++++++++++++ src/Unused/Types.hs | 109 ----------------------------- unused.cabal | 3 + 8 files changed, 138 insertions(+), 111 deletions(-) create mode 100644 src/Unused/DirectoryGrouping.hs create mode 100644 src/Unused/LikelihoodCalculator.hs create mode 100644 src/Unused/ResponseFilter.hs diff --git a/app/Main.hs b/app/Main.hs index 8cf57d5..d51185d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,7 +3,7 @@ module Main where import Options.Applicative import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) import Unused.Parser (parseLines) -import Unused.Types (withOneOccurrence, withOneFile) +import Unused.ResponseFilter (withOneOccurrence, withOneFile) import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen) data Options = Options diff --git a/src/Unused/CLI/SearchResult.hs b/src/Unused/CLI/SearchResult.hs index 2db8b2e..94cc94b 100644 --- a/src/Unused/CLI/SearchResult.hs +++ b/src/Unused/CLI/SearchResult.hs @@ -4,7 +4,9 @@ module Unused.CLI.SearchResult import Control.Monad (forM_) import Text.Printf +import qualified Data.Map.Strict as Map import Unused.Types +import Unused.DirectoryGrouping (DirectoryPrefix(..), responsesGroupedByPath) import Unused.CLI.Util printSearchResults :: TermMatchSet -> IO () @@ -17,6 +19,10 @@ printSearchResults termMatchSet = termLength = return . length . tmTerm maxWidth = maximum $ termLength =<< trMatches =<< allResults +listFromMatchSet :: TermMatchSet -> [(String, TermResults)] +listFromMatchSet = + Map.toList + printDirectorySection :: Int -> (DirectoryPrefix, TermMatchSet) -> IO () printDirectorySection w (dir, ss) = do printDirectory dir diff --git a/src/Unused/DirectoryGrouping.hs b/src/Unused/DirectoryGrouping.hs new file mode 100644 index 0000000..774f227 --- /dev/null +++ b/src/Unused/DirectoryGrouping.hs @@ -0,0 +1,37 @@ +module Unused.DirectoryGrouping + ( DirectoryPrefix(..) + , responsesGroupedByPath + ) where + +import System.FilePath (takeDirectory, splitDirectories) +import qualified Data.Map.Strict as Map +import Data.List (intercalate, sort, nub) +import Unused.Types + +newtype DirectoryPrefix = DirectoryPrefix String deriving (Eq, Show, Ord) + +responsesGroupedByPath :: TermMatchSet -> [(DirectoryPrefix, TermMatchSet)] +responsesGroupedByPath pr = + (\p -> (p, responseForPath p pr)) <$> directoriesForGrouping pr + +responseForPath :: DirectoryPrefix -> TermMatchSet -> TermMatchSet +responseForPath s = + filterVByPath . filterKVByPath + where + filterVByPath = Map.map (updateMatchesWith newMatches) + filterKVByPath = Map.filterWithKey (const $ \a -> s `elem` allPaths a) + allPaths = fmap (fileNameGrouping . tmPath) . trMatches + updateMatchesWith f tr = tr { trMatches = f tr } + newMatches = filter ((== s) . fileNameGrouping . tmPath) . trMatches + +fileNameGrouping :: String -> DirectoryPrefix +fileNameGrouping = + DirectoryPrefix . grouping + where + grouping = intercalate "/" . take 2 . splitDirectories . takeDirectory + +directoriesForGrouping :: TermMatchSet -> [DirectoryPrefix] +directoriesForGrouping = + uniqueValues . Map.map (fmap (fileNameGrouping . tmPath) . trMatches) + where + uniqueValues = sort . nub . concat . Map.elems diff --git a/src/Unused/LikelihoodCalculator.hs b/src/Unused/LikelihoodCalculator.hs new file mode 100644 index 0000000..936dfca --- /dev/null +++ b/src/Unused/LikelihoodCalculator.hs @@ -0,0 +1,20 @@ +module Unused.LikelihoodCalculator + ( calculateLikelihood + ) where + +import Unused.Types (TermResults, RemovalLikelihood(..), trRemovalLikelihood, trTotalOccurrences) +import Unused.ResponseFilter (railsSingleOkay, elixirSingleOkay) + +calculateLikelihood :: TermResults -> TermResults +calculateLikelihood r = + r { trRemovalLikelihood = newLikelihood } + where + baseScore = trTotalOccurrences 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 diff --git a/src/Unused/Parser.hs b/src/Unused/Parser.hs index e858704..bccd723 100644 --- a/src/Unused/Parser.hs +++ b/src/Unused/Parser.hs @@ -9,7 +9,8 @@ import Text.Parsec import Text.Parsec.String (Parser) import qualified Data.Map.Strict as Map import Unused.Util (groupBy) -import Unused.Types (TermMatch(..), ParseResponse, resultsFromMatches) +import Unused.Types +import Unused.LikelihoodCalculator parseLines :: String -> ParseResponse parseLines = @@ -19,6 +20,22 @@ responseFromParse :: Either ParseError [TermMatch] -> ParseResponse responseFromParse = fmap $ Map.fromList . map (second resultsFromMatches) . groupBy tmTerm +resultsFromMatches :: [TermMatch] -> TermResults +resultsFromMatches m = + calculateLikelihood TermResults + { trTerm = resultTerm terms + , trMatches = m + , trTotalFiles = totalFiles + , trTotalOccurrences = totalOccurrences + , trRemovalLikelihood = High + } + where + totalFiles = length m + totalOccurrences = sum $ fmap tmOccurrences m + terms = map tmTerm m + resultTerm (x:_) = x + resultTerm _ = "" + parseTermMatches :: Parser [TermMatch] parseTermMatches = do tm <- many1 $ do diff --git a/src/Unused/ResponseFilter.hs b/src/Unused/ResponseFilter.hs new file mode 100644 index 0000000..4b7d28f --- /dev/null +++ b/src/Unused/ResponseFilter.hs @@ -0,0 +1,53 @@ +module Unused.ResponseFilter + ( withOneFile + , withOneOccurrence + , oneFile + , oneOccurence + , isClassOrModule + , railsSingleOkay + , elixirSingleOkay + ) where + +import qualified Data.Map.Strict as Map +import Unused.Regex (matchRegex) +import Unused.Types + +withOneFile :: ParseResponse -> ParseResponse +withOneFile = applyFilter (const oneFile) + +withOneOccurrence :: ParseResponse -> ParseResponse +withOneOccurrence = applyFilter (const oneOccurence) + +oneOccurence :: TermResults -> Bool +oneOccurence = (== 1) . trTotalOccurrences + +oneFile :: TermResults -> Bool +oneFile = (== 1) . trTotalFiles + +isClassOrModule :: TermResults -> Bool +isClassOrModule = matchRegex "^[A-Z]" . trTerm + +railsSingleOkay :: TermResults -> Bool +railsSingleOkay r = + and [isClassOrModule r, oneFile r, oneOccurence r, controller || helper || migration] + where + controller = matchRegex "^app/controllers/" singlePath && matchRegex "Controller$" (trTerm r) + helper = matchRegex "^app/helpers/" singlePath && matchRegex "Helper$" (trTerm r) + migration = matchRegex "^db/migrate/" singlePath + singlePath = path $ tmPath <$> trMatches r + path (x:_) = x + path [] = "" + +elixirSingleOkay :: TermResults -> Bool +elixirSingleOkay r = + and [isClassOrModule r, oneFile r, oneOccurence r, view || test || migration] + where + migration = matchRegex "^priv/repo/migrations/" singlePath + view = matchRegex "^web/views/" singlePath && matchRegex "View$" (trTerm r) + test = matchRegex "^test/" singlePath && matchRegex "Test$" (trTerm r) + singlePath = path $ tmPath <$> trMatches r + path (x:_) = x + path [] = "" + +applyFilter :: (String -> TermResults -> Bool) -> ParseResponse -> ParseResponse +applyFilter = fmap . Map.filterWithKey diff --git a/src/Unused/Types.hs b/src/Unused/Types.hs index b030365..9816be7 100644 --- a/src/Unused/Types.hs +++ b/src/Unused/Types.hs @@ -3,21 +3,11 @@ module Unused.Types , TermResults(..) , TermMatchSet , ParseResponse - , DirectoryPrefix(..) , RemovalLikelihood(..) - , listFromMatchSet - , withOneFile - , withOneOccurrence - , resultsFromMatches - , responsesGroupedByPath ) where -import System.FilePath (takeDirectory, splitDirectories) 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 { tmTerm :: String @@ -38,102 +28,3 @@ data RemovalLikelihood = High | Medium | Low deriving Show type TermMatchSet = Map.Map String TermResults type ParseResponse = Either ParseError TermMatchSet - -newtype DirectoryPrefix = DirectoryPrefix String deriving (Eq, Show, Ord) - -resultsFromMatches :: [TermMatch] -> TermResults -resultsFromMatches m = - calculateLikelihood TermResults - { trTerm = resultTerm terms - , trMatches = m - , trTotalFiles = totalFiles - , trTotalOccurrences = totalOccurrences - , trRemovalLikelihood = High - } - where - totalFiles = length m - totalOccurrences = sum $ fmap tmOccurrences m - terms = map tmTerm m - resultTerm (x:_) = x - resultTerm _ = "" - -withOneFile :: ParseResponse -> ParseResponse -withOneFile = fmap $ Map.filterWithKey (const oneFile) - -withOneOccurrence :: ParseResponse -> ParseResponse -withOneOccurrence = fmap $ Map.filterWithKey (const oneOccurence) - -oneOccurence :: TermResults -> Bool -oneOccurence = (== 1) . trTotalOccurrences - -oneFile :: TermResults -> Bool -oneFile = (== 1) . trTotalFiles - -isClassOrModule :: TermResults -> Bool -isClassOrModule = matchRegex "^[A-Z]" . trTerm - -railsSingleOkay :: TermResults -> Bool -railsSingleOkay r = - and [isClassOrModule r, oneFile r, oneOccurence r, controller || helper || migration] - where - controller = matchRegex "^app/controllers/" singlePath && matchRegex "Controller$" (trTerm r) - helper = matchRegex "^app/helpers/" singlePath && matchRegex "Helper$" (trTerm r) - migration = matchRegex "^db/migrate/" singlePath - singlePath = path $ tmPath <$> trMatches r - path (x:_) = x - path [] = "" - -elixirSingleOkay :: TermResults -> Bool -elixirSingleOkay r = - and [isClassOrModule r, oneFile r, oneOccurence r, view || test || migration] - where - migration = matchRegex "^priv/repo/migrations/" singlePath - view = matchRegex "^web/views/" singlePath && matchRegex "View$" (trTerm r) - test = matchRegex "^test/" singlePath && matchRegex "Test$" (trTerm r) - singlePath = path $ tmPath <$> trMatches r - path (x:_) = x - path [] = "" - -listFromMatchSet :: TermMatchSet -> [(String, TermResults)] -listFromMatchSet = - Map.toList - -responsesGroupedByPath :: TermMatchSet -> [(DirectoryPrefix, TermMatchSet)] -responsesGroupedByPath pr = - (\p -> (p, responseForPath p pr)) <$> directoriesForGrouping pr - -responseForPath :: DirectoryPrefix -> TermMatchSet -> TermMatchSet -responseForPath s = - filterVByPath . filterKVByPath - where - filterVByPath = Map.map (updateMatchesWith newMatches) - filterKVByPath = Map.filterWithKey (const $ \a -> s `elem` allPaths a) - allPaths = fmap (fileNameGrouping . tmPath) . trMatches - updateMatchesWith f tr = tr { trMatches = f tr } - newMatches = filter ((== s) . fileNameGrouping . tmPath) . trMatches - -fileNameGrouping :: String -> DirectoryPrefix -fileNameGrouping = - DirectoryPrefix . grouping - where - grouping = intercalate "/" . take 2 . splitDirectories . takeDirectory - -directoriesForGrouping :: TermMatchSet -> [DirectoryPrefix] -directoriesForGrouping = - uniqueValues . Map.map (fmap (fileNameGrouping . tmPath) . trMatches) - where - uniqueValues = sort . nub . concat . Map.elems - -calculateLikelihood :: TermResults -> TermResults -calculateLikelihood r = - r { trRemovalLikelihood = newLikelihood } - where - baseScore = trTotalOccurrences 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 diff --git a/unused.cabal b/unused.cabal index 6fb1174..5ef28ae 100644 --- a/unused.cabal +++ b/unused.cabal @@ -20,6 +20,9 @@ library , Unused.Types , Unused.Util , Unused.Regex + , Unused.ResponseFilter + , Unused.DirectoryGrouping + , Unused.LikelihoodCalculator , Unused.CLI , Unused.CLI.Search , Unused.CLI.SearchError