mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Allow search result grouping
Why? ==== Grouping results can be helpful to view information differently, e.g. to see highest-offending files or to remove grouping entirely. This introduces a flag to allow overriding the default group (two levels of directory)
This commit is contained in:
parent
a8a9d250e3
commit
bcbc1b6462
25
app/Main.hs
25
app/Main.hs
@ -2,9 +2,11 @@ module Main where
|
||||
|
||||
import Options.Applicative
|
||||
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Unused.Parser (parseLines)
|
||||
import Unused.Types (ParseResponse, RemovalLikelihood(..))
|
||||
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
||||
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
|
||||
import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen, withInterruptHandler)
|
||||
|
||||
data Options = Options
|
||||
@ -13,6 +15,7 @@ data Options = Options
|
||||
, oLikelihoods :: [RemovalLikelihood]
|
||||
, oAllLikelihoods :: Bool
|
||||
, oIgnoredPaths :: [String]
|
||||
, oGrouping :: CurrentGrouping
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
@ -37,7 +40,7 @@ run options = do
|
||||
|
||||
resetScreen
|
||||
|
||||
either printParseError printSearchResults $
|
||||
either printParseError (printSearchResults . groupedResponses (oGrouping options)) $
|
||||
optionFilters options response
|
||||
|
||||
return ()
|
||||
@ -68,6 +71,7 @@ parseOptions =
|
||||
<*> parseLikelihoods
|
||||
<*> parseAllLikelihoods
|
||||
<*> parseIgnorePaths
|
||||
<*> parseGroupings
|
||||
|
||||
parseSearchRunner :: Parser SearchRunner
|
||||
parseSearchRunner =
|
||||
@ -108,3 +112,22 @@ parseIgnorePaths = many $ strOption $
|
||||
long "ignore"
|
||||
<> metavar "PATH"
|
||||
<> help "[Allows multiple] Ignore paths that contain PATH"
|
||||
|
||||
parseGroupings :: Parser CurrentGrouping
|
||||
parseGroupings =
|
||||
fromMaybe GroupByDirectory <$> maybeGroup
|
||||
where
|
||||
maybeGroup = optional $ parseGrouping <$> parseGroupingOption
|
||||
|
||||
parseGrouping :: String -> CurrentGrouping
|
||||
parseGrouping "directory" = GroupByDirectory
|
||||
parseGrouping "term" = GroupByTerm
|
||||
parseGrouping "file" = GroupByFile
|
||||
parseGrouping "none" = NoGroup
|
||||
parseGrouping _ = NoGroup
|
||||
|
||||
parseGroupingOption :: Parser String
|
||||
parseGroupingOption = strOption $
|
||||
short 'g'
|
||||
<> long "group-by"
|
||||
<> help "[Allowed: directory, term, file, none] Group results"
|
||||
|
@ -5,39 +5,39 @@ module Unused.CLI.SearchResult
|
||||
import Control.Monad (forM_)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Unused.Types
|
||||
import Unused.DirectoryGrouping (DirectoryPrefix(..), responsesGroupedByPath)
|
||||
import Unused.Grouping (Grouping(..), GroupedTerms)
|
||||
import Unused.CLI.SearchResult.ColumnFormatter
|
||||
import Unused.CLI.Util
|
||||
|
||||
printSearchResults :: TermMatchSet -> IO ()
|
||||
printSearchResults termMatchSet =
|
||||
printSearchResults :: [GroupedTerms] -> IO ()
|
||||
printSearchResults responses =
|
||||
printFormattedResponses columnFormat responses
|
||||
where
|
||||
responses = responsesGroupedByPath termMatchSet
|
||||
allSets = listFromMatchSet =<< map snd responses
|
||||
allResults = map snd allSets
|
||||
columnFormat = buildColumnFormatter allResults
|
||||
|
||||
printFormattedResponses :: ColumnFormat -> [(DirectoryPrefix, TermMatchSet)] -> IO ()
|
||||
printFormattedResponses :: ColumnFormat -> [GroupedTerms] -> IO ()
|
||||
printFormattedResponses _ [] = printNoResultsFound
|
||||
printFormattedResponses cf r = mapM_ (printDirectorySection cf) r
|
||||
printFormattedResponses cf r = mapM_ (printGroupingSection cf) r
|
||||
|
||||
listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
|
||||
listFromMatchSet =
|
||||
Map.toList
|
||||
|
||||
printDirectorySection :: ColumnFormat -> (DirectoryPrefix, TermMatchSet) -> IO ()
|
||||
printDirectorySection cf (dir, ss) = do
|
||||
printDirectory dir
|
||||
printGroupingSection :: ColumnFormat -> GroupedTerms -> IO ()
|
||||
printGroupingSection cf (g, ss) = do
|
||||
printGrouping g
|
||||
mapM_ (printTermResults cf) $ listFromMatchSet ss
|
||||
putStr "\n"
|
||||
|
||||
printDirectory :: DirectoryPrefix -> IO ()
|
||||
printDirectory (DirectoryPrefix dir) = do
|
||||
setSGR [SetColor Foreground Vivid Black]
|
||||
setSGR [SetConsoleIntensity BoldIntensity]
|
||||
putStrLn dir
|
||||
setSGR [Reset]
|
||||
printGrouping :: Grouping -> IO ()
|
||||
printGrouping NoGrouping = return ()
|
||||
printGrouping g = do
|
||||
putStr "\n"
|
||||
setSGR [SetColor Foreground Vivid Black]
|
||||
setSGR [SetConsoleIntensity BoldIntensity]
|
||||
print g
|
||||
setSGR [Reset]
|
||||
|
||||
printTermResults :: ColumnFormat -> (String, TermResults) -> IO ()
|
||||
printTermResults cf (_, results) =
|
||||
|
@ -1,34 +0,0 @@
|
||||
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
|
||||
import Unused.ResponseFilter (updateMatches)
|
||||
|
||||
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 =
|
||||
updateMatches newMatches
|
||||
where
|
||||
newMatches = filter ((== s) . fileNameGrouping . tmPath)
|
||||
|
||||
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
|
32
src/Unused/Grouping.hs
Normal file
32
src/Unused/Grouping.hs
Normal file
@ -0,0 +1,32 @@
|
||||
module Unused.Grouping
|
||||
( Grouping(..)
|
||||
, CurrentGrouping(..)
|
||||
, GroupedTerms
|
||||
, groupedResponses
|
||||
) where
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.List (sort, nub)
|
||||
import Unused.Types
|
||||
import Unused.ResponseFilter (updateMatches)
|
||||
import Unused.Grouping.Types
|
||||
import Unused.Grouping.Internal
|
||||
|
||||
groupedResponses :: CurrentGrouping -> TermMatchSet -> [GroupedTerms]
|
||||
groupedResponses g tms =
|
||||
(\g' -> (g', groupedMatchSetSubsets currentGroup g' tms)) <$> groupingsFromSet
|
||||
where
|
||||
groupingsFromSet = allGroupings currentGroup tms
|
||||
currentGroup = groupFilter g
|
||||
|
||||
groupedMatchSetSubsets :: GroupFilter -> Grouping -> TermMatchSet -> TermMatchSet
|
||||
groupedMatchSetSubsets f tms =
|
||||
updateMatches newMatches
|
||||
where
|
||||
newMatches = filter ((== tms) . f)
|
||||
|
||||
allGroupings :: GroupFilter -> TermMatchSet -> [Grouping]
|
||||
allGroupings f =
|
||||
uniqueValues . Map.map (fmap f . trMatches)
|
||||
where
|
||||
uniqueValues = sort . nub . concat . Map.elems
|
27
src/Unused/Grouping/Internal.hs
Normal file
27
src/Unused/Grouping/Internal.hs
Normal file
@ -0,0 +1,27 @@
|
||||
module Unused.Grouping.Internal
|
||||
( groupFilter
|
||||
) where
|
||||
|
||||
import Unused.Grouping.Types
|
||||
import System.FilePath (takeDirectory, splitDirectories)
|
||||
import Unused.Types (tmPath, tmTerm)
|
||||
import Data.List (intercalate)
|
||||
|
||||
groupFilter :: CurrentGrouping -> GroupFilter
|
||||
groupFilter GroupByDirectory = fileNameGrouping
|
||||
groupFilter GroupByTerm = termGrouping
|
||||
groupFilter GroupByFile = fileGrouping
|
||||
groupFilter NoGroup = const NoGrouping
|
||||
|
||||
fileNameGrouping :: GroupFilter
|
||||
fileNameGrouping = ByDirectory . shortenedDirectory . tmPath
|
||||
|
||||
termGrouping :: GroupFilter
|
||||
termGrouping = ByTerm . tmTerm
|
||||
|
||||
fileGrouping :: GroupFilter
|
||||
fileGrouping = ByFile . tmPath
|
||||
|
||||
shortenedDirectory :: String -> String
|
||||
shortenedDirectory =
|
||||
intercalate "/" . take 2 . splitDirectories . takeDirectory
|
20
src/Unused/Grouping/Types.hs
Normal file
20
src/Unused/Grouping/Types.hs
Normal file
@ -0,0 +1,20 @@
|
||||
module Unused.Grouping.Types
|
||||
( Grouping(..)
|
||||
, CurrentGrouping(..)
|
||||
, GroupedTerms
|
||||
, GroupFilter
|
||||
) where
|
||||
|
||||
import Unused.Types (TermMatchSet, TermMatch)
|
||||
|
||||
data Grouping = ByDirectory String | ByTerm String | ByFile String | NoGrouping deriving (Eq, Ord)
|
||||
data CurrentGrouping = GroupByDirectory | GroupByTerm | GroupByFile | NoGroup
|
||||
|
||||
type GroupedTerms = (Grouping, TermMatchSet)
|
||||
type GroupFilter = TermMatch -> Grouping
|
||||
|
||||
instance Show Grouping where
|
||||
show (ByDirectory s) = s
|
||||
show (ByTerm s) = s
|
||||
show (ByFile s) = s
|
||||
show NoGrouping = ""
|
35
test/Unused/Grouping/InternalSpec.hs
Normal file
35
test/Unused/Grouping/InternalSpec.hs
Normal file
@ -0,0 +1,35 @@
|
||||
module Unused.Grouping.InternalSpec
|
||||
( main
|
||||
, spec
|
||||
) where
|
||||
|
||||
import Test.Hspec
|
||||
import Unused.Types
|
||||
import Unused.Grouping.Internal
|
||||
import Unused.Grouping.Types
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $
|
||||
describe "groupFilter" $ do
|
||||
it "groups by directory" $ do
|
||||
let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10
|
||||
|
||||
groupFilter GroupByDirectory termMatch `shouldBe` ByDirectory "foo/bar"
|
||||
|
||||
it "groups by term" $ do
|
||||
let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10
|
||||
|
||||
groupFilter GroupByTerm termMatch `shouldBe` ByTerm "AwesomeClass"
|
||||
|
||||
it "groups by file" $ do
|
||||
let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10
|
||||
|
||||
groupFilter GroupByFile termMatch `shouldBe` ByFile "foo/bar/baz/buzz.rb"
|
||||
|
||||
it "groups by nothing" $ do
|
||||
let termMatch = TermMatch "AwesomeClass" "foo/bar/baz/buzz.rb" 10
|
||||
|
||||
groupFilter NoGroup termMatch `shouldBe` NoGrouping
|
@ -22,7 +22,9 @@ library
|
||||
, Unused.Util
|
||||
, Unused.Regex
|
||||
, Unused.ResponseFilter
|
||||
, Unused.DirectoryGrouping
|
||||
, Unused.Grouping
|
||||
, Unused.Grouping.Internal
|
||||
, Unused.Grouping.Types
|
||||
, Unused.LikelihoodCalculator
|
||||
, Unused.CLI
|
||||
, Unused.CLI.Search
|
||||
@ -68,6 +70,7 @@ test-suite unused-test
|
||||
, Unused.ResponseFilterSpec
|
||||
, Unused.TypesSpec
|
||||
, Unused.LikelihoodCalculatorSpec
|
||||
, Unused.Grouping.InternalSpec
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror
|
||||
default-language: Haskell2010
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user