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 Options.Applicative
|
||||||
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
import Unused.Parser (parseLines)
|
import Unused.Parser (parseLines)
|
||||||
import Unused.Types (ParseResponse, RemovalLikelihood(..))
|
import Unused.Types (ParseResponse, RemovalLikelihood(..))
|
||||||
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
import Unused.ResponseFilter (withOneOccurrence, withLikelihoods, ignoringPaths)
|
||||||
|
import Unused.Grouping (CurrentGrouping(..), groupedResponses)
|
||||||
import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen, withInterruptHandler)
|
import Unused.CLI (SearchRunner(..), executeSearch, printParseError, printSearchResults, resetScreen, withInterruptHandler)
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
@ -13,6 +15,7 @@ data Options = Options
|
|||||||
, oLikelihoods :: [RemovalLikelihood]
|
, oLikelihoods :: [RemovalLikelihood]
|
||||||
, oAllLikelihoods :: Bool
|
, oAllLikelihoods :: Bool
|
||||||
, oIgnoredPaths :: [String]
|
, oIgnoredPaths :: [String]
|
||||||
|
, oGrouping :: CurrentGrouping
|
||||||
}
|
}
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
@ -37,7 +40,7 @@ run options = do
|
|||||||
|
|
||||||
resetScreen
|
resetScreen
|
||||||
|
|
||||||
either printParseError printSearchResults $
|
either printParseError (printSearchResults . groupedResponses (oGrouping options)) $
|
||||||
optionFilters options response
|
optionFilters options response
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
@ -68,6 +71,7 @@ parseOptions =
|
|||||||
<*> parseLikelihoods
|
<*> parseLikelihoods
|
||||||
<*> parseAllLikelihoods
|
<*> parseAllLikelihoods
|
||||||
<*> parseIgnorePaths
|
<*> parseIgnorePaths
|
||||||
|
<*> parseGroupings
|
||||||
|
|
||||||
parseSearchRunner :: Parser SearchRunner
|
parseSearchRunner :: Parser SearchRunner
|
||||||
parseSearchRunner =
|
parseSearchRunner =
|
||||||
@ -108,3 +112,22 @@ parseIgnorePaths = many $ strOption $
|
|||||||
long "ignore"
|
long "ignore"
|
||||||
<> metavar "PATH"
|
<> metavar "PATH"
|
||||||
<> help "[Allows multiple] Ignore paths that contain 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 Control.Monad (forM_)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Unused.Types
|
import Unused.Types
|
||||||
import Unused.DirectoryGrouping (DirectoryPrefix(..), responsesGroupedByPath)
|
import Unused.Grouping (Grouping(..), GroupedTerms)
|
||||||
import Unused.CLI.SearchResult.ColumnFormatter
|
import Unused.CLI.SearchResult.ColumnFormatter
|
||||||
import Unused.CLI.Util
|
import Unused.CLI.Util
|
||||||
|
|
||||||
printSearchResults :: TermMatchSet -> IO ()
|
printSearchResults :: [GroupedTerms] -> IO ()
|
||||||
printSearchResults termMatchSet =
|
printSearchResults responses =
|
||||||
printFormattedResponses columnFormat responses
|
printFormattedResponses columnFormat responses
|
||||||
where
|
where
|
||||||
responses = responsesGroupedByPath termMatchSet
|
|
||||||
allSets = listFromMatchSet =<< map snd responses
|
allSets = listFromMatchSet =<< map snd responses
|
||||||
allResults = map snd allSets
|
allResults = map snd allSets
|
||||||
columnFormat = buildColumnFormatter allResults
|
columnFormat = buildColumnFormatter allResults
|
||||||
|
|
||||||
printFormattedResponses :: ColumnFormat -> [(DirectoryPrefix, TermMatchSet)] -> IO ()
|
printFormattedResponses :: ColumnFormat -> [GroupedTerms] -> IO ()
|
||||||
printFormattedResponses _ [] = printNoResultsFound
|
printFormattedResponses _ [] = printNoResultsFound
|
||||||
printFormattedResponses cf r = mapM_ (printDirectorySection cf) r
|
printFormattedResponses cf r = mapM_ (printGroupingSection cf) r
|
||||||
|
|
||||||
listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
|
listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
|
||||||
listFromMatchSet =
|
listFromMatchSet =
|
||||||
Map.toList
|
Map.toList
|
||||||
|
|
||||||
printDirectorySection :: ColumnFormat -> (DirectoryPrefix, TermMatchSet) -> IO ()
|
printGroupingSection :: ColumnFormat -> GroupedTerms -> IO ()
|
||||||
printDirectorySection cf (dir, ss) = do
|
printGroupingSection cf (g, ss) = do
|
||||||
printDirectory dir
|
printGrouping g
|
||||||
mapM_ (printTermResults cf) $ listFromMatchSet ss
|
mapM_ (printTermResults cf) $ listFromMatchSet ss
|
||||||
putStr "\n"
|
|
||||||
|
|
||||||
printDirectory :: DirectoryPrefix -> IO ()
|
printGrouping :: Grouping -> IO ()
|
||||||
printDirectory (DirectoryPrefix dir) = do
|
printGrouping NoGrouping = return ()
|
||||||
setSGR [SetColor Foreground Vivid Black]
|
printGrouping g = do
|
||||||
setSGR [SetConsoleIntensity BoldIntensity]
|
putStr "\n"
|
||||||
putStrLn dir
|
setSGR [SetColor Foreground Vivid Black]
|
||||||
setSGR [Reset]
|
setSGR [SetConsoleIntensity BoldIntensity]
|
||||||
|
print g
|
||||||
|
setSGR [Reset]
|
||||||
|
|
||||||
printTermResults :: ColumnFormat -> (String, TermResults) -> IO ()
|
printTermResults :: ColumnFormat -> (String, TermResults) -> IO ()
|
||||||
printTermResults cf (_, results) =
|
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.Util
|
||||||
, Unused.Regex
|
, Unused.Regex
|
||||||
, Unused.ResponseFilter
|
, Unused.ResponseFilter
|
||||||
, Unused.DirectoryGrouping
|
, Unused.Grouping
|
||||||
|
, Unused.Grouping.Internal
|
||||||
|
, Unused.Grouping.Types
|
||||||
, Unused.LikelihoodCalculator
|
, Unused.LikelihoodCalculator
|
||||||
, Unused.CLI
|
, Unused.CLI
|
||||||
, Unused.CLI.Search
|
, Unused.CLI.Search
|
||||||
@ -68,6 +70,7 @@ test-suite unused-test
|
|||||||
, Unused.ResponseFilterSpec
|
, Unused.ResponseFilterSpec
|
||||||
, Unused.TypesSpec
|
, Unused.TypesSpec
|
||||||
, Unused.LikelihoodCalculatorSpec
|
, Unused.LikelihoodCalculatorSpec
|
||||||
|
, Unused.Grouping.InternalSpec
|
||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user