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)

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"

src/Unused/CLI/SearchResult.hs

@@ -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) =

src/Unused/DirectoryGrouping.hs

@@ -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

src/Unused/Grouping.hs

@@ -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

src/Unused/Grouping/Internal.hs

@@ -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

src/Unused/Grouping/Types.hs

@@ -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 = ""

test/Unused/Grouping/InternalSpec.hs

@@ -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

unused.cabal

@@ -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