mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Improve output by grouping by directory structure
This commit is contained in:
parent
30b00225f4
commit
49b7b65b17
40
app/Main.hs
40
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"
|
||||
|
||||
|
@ -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
|
||||
|
@ -23,6 +23,7 @@ library
|
||||
, process
|
||||
, parsec
|
||||
, containers
|
||||
, filepath
|
||||
default-language: Haskell2010
|
||||
|
||||
executable unused
|
||||
|
Loading…
Reference in New Issue
Block a user