diff --git a/app/Main.hs b/app/Main.hs index 829140a..45d1f64 100644 --- a/app/Main.hs +++ b/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" diff --git a/src/Unused/Types.hs b/src/Unused/Types.hs index 939b5ec..63bbd16 100644 --- a/src/Unused/Types.hs +++ b/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 diff --git a/unused.cabal b/unused.cabal index 7ccfb4f..a5b5452 100644 --- a/unused.cabal +++ b/unused.cabal @@ -23,6 +23,7 @@ library , process , parsec , containers + , filepath default-language: Haskell2010 executable unused