Improve output by grouping by directory structure

app/Main.hs

@@ -17,7 +17,8 @@ main = do
     case withOneOccurrence $ withOneFile response of
         Right termMatchSet -> do
             clearScreen
-            mapM_ printMatchPair $ listFromMatchSet termMatchSet
+            let responses = responsesGroupedByPath termMatchSet
+            mapM_ printDirectorySection responses
         Left e ->
             printParseError e
 
@@ -75,24 +76,35 @@ printAnalysisHeader terms = do
     setSGR [Reset]
     putStr " terms\n\n"
 
-printMatchPair :: (String, [TermMatch]) -> IO ()
-printMatchPair (term', matches) = do
-    setSGR   [SetColor Foreground Vivid Red]
-    setSGR   [SetConsoleIntensity BoldIntensity]
-    putStrLn term'
-    setSGR   [Reset]
-    printMatches matches
+printDirectorySection :: (DirectoryPrefix, TermMatchSet) -> IO ()
+printDirectorySection (dir, ss) = do
+    printDirectory dir
+    mapM_ printTermResults $ listFromMatchSet ss
     putStr "\n"
 
-printMatches :: [TermMatch] -> IO ()
-printMatches matches = do
-    mapM_ printMatch matches
+printDirectory :: DirectoryPrefix -> IO ()
+printDirectory (DirectoryPrefix dir) = do
+    setSGR   [SetColor Foreground Vivid Black]
+    setSGR   [SetConsoleIntensity BoldIntensity]
+    putStrLn dir
+    setSGR   [Reset]
+
+printTermResults :: (String, TermResults) -> IO ()
+printTermResults (_, results) = do
+    printMatches results $ matches results
+
+printMatches :: TermResults -> [TermMatch] -> IO ()
+printMatches _r ms = do
+    mapM_ printMatch ms
   where
     printMatch m = do
-        setSGR [SetColor Foreground Dull Green]
+        setSGR [SetColor Foreground Dull Red]
+        setSGR [SetConsoleIntensity NormalIntensity]
+        putStr $ "     " ++ term m
+        setSGR [Reset]
+        setSGR [SetColor Foreground Dull Cyan]
+        setSGR [SetConsoleIntensity FaintIntensity]
         putStr $ "  " ++ path m
-        setSGR [SetColor Foreground Dull Yellow]
-        putStr $ " " ++ (show . occurrences) m ++ " "
         setSGR [Reset]
         putStr "\n"
 

src/Unused/Types.hs

@@ -1,15 +1,20 @@
 module Unused.Types
     ( TermMatch(..)
+    , TermResults(..)
     , TermMatchSet
-    , ParseResponse(..)
+    , ParseResponse
+    , DirectoryPrefix(..)
     , 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
 
 data TermMatch = TermMatch
@@ -28,6 +33,8 @@ type TermMatchSet = Map.Map String TermResults
 
 type ParseResponse = Either ParseError TermMatchSet
 
+newtype DirectoryPrefix = DirectoryPrefix String deriving (Eq, Show, Ord)
+
 resultsFromMatches :: [TermMatch] -> TermResults
 resultsFromMatches m =
     TermResults
@@ -45,6 +52,30 @@ withOneFile = fmap $ Map.filterWithKey (const $ ((==) 1) . totalFiles)
 withOneOccurrence :: ParseResponse -> ParseResponse
 withOneOccurrence = fmap $ Map.filterWithKey (const $ ((==) 1 ) . totalOccurrences)
 
-listFromMatchSet :: TermMatchSet -> [(String, [TermMatch])]
+listFromMatchSet :: TermMatchSet -> [(String, TermResults)]
 listFromMatchSet =
-  map (second matches) . Map.toList
+  Map.toList
+
+responsesGroupedByPath :: TermMatchSet -> [(DirectoryPrefix, TermMatchSet)]
+responsesGroupedByPath pr =
+    fmap (\p -> (p, responseForPath p pr)) $ directoriesForGrouping pr
+
+responseForPath :: DirectoryPrefix -> TermMatchSet -> TermMatchSet
+responseForPath s =
+    filterVByPath . filterKVByPath
+  where
+    filterVByPath = Map.map (resultsFromMatches . filter (((==) s) . fileNameGrouping . path) . matches)
+    filterKVByPath = Map.filterWithKey (\_ a -> s `elem` allPaths a)
+    allPaths = fmap (fileNameGrouping . path) . matches
+
+fileNameGrouping :: String -> DirectoryPrefix
+fileNameGrouping =
+    DirectoryPrefix . grouping
+  where
+    grouping = intercalate "/" . take 2 . splitDirectories . takeDirectory
+
+directoriesForGrouping :: TermMatchSet -> [DirectoryPrefix]
+directoriesForGrouping =
+    uniqueValues . Map.map (fmap (fileNameGrouping . path) . matches)
+  where
+    uniqueValues = sort . nub . concat . Map.elems

unused.cabal

@@ -23,6 +23,7 @@ library
                      , process
                      , parsec
                      , containers
+                     , filepath
   default-language:    Haskell2010
 
 executable unused