mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-17 15:47:23 +03:00
Initial pass at adding color to output
This commit is contained in:
parent
a5230f163e
commit
ed72d2405a
37
app/Main.hs
37
app/Main.hs
@ -1,12 +1,45 @@
|
||||
module Main where
|
||||
|
||||
import System.Console.ANSI
|
||||
import Data.List (nub)
|
||||
import Unused.TermSearch (search)
|
||||
import Unused.Parser (parseLines)
|
||||
import Unused.Types
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
terms <- pure . lines =<< getContents
|
||||
results <- pure . concat =<< mapM search terms
|
||||
let matches = parseLines $ unlines results
|
||||
let groupedMatches = groupBy term $ parseLines $ unlines results
|
||||
|
||||
print matches
|
||||
mapM_ printMatchPair groupedMatches
|
||||
|
||||
return ()
|
||||
|
||||
printMatchPair :: (String, [TermMatch]) -> IO ()
|
||||
printMatchPair (term', matches) = do
|
||||
setSGR [SetColor Foreground Vivid Red]
|
||||
setSGR [SetConsoleIntensity BoldIntensity]
|
||||
putStrLn term'
|
||||
setSGR [Reset]
|
||||
printMatches matches
|
||||
putStr "\n"
|
||||
|
||||
printMatches :: [TermMatch] -> IO ()
|
||||
printMatches matches = do
|
||||
mapM_ printMatch matches
|
||||
where
|
||||
printMatch m = do
|
||||
setSGR [SetColor Foreground Dull Green]
|
||||
putStr $ " " ++ path m
|
||||
setSGR [SetColor Foreground Dull Yellow]
|
||||
putStr $ " " ++ (show . occurrences) m ++ " "
|
||||
setSGR [Reset]
|
||||
putStr "\n"
|
||||
|
||||
groupBy :: Eq b => (a -> b) -> [a] -> [(b, [a])]
|
||||
groupBy f l =
|
||||
fmap (\t -> (t, byTerm t)) uniqueTerms
|
||||
where
|
||||
byTerm t = filter (((==) t) . f) l
|
||||
uniqueTerms = nub $ fmap f l
|
||||
|
@ -29,6 +29,7 @@ executable unused
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
build-depends: base
|
||||
, unused
|
||||
, ansi-terminal
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite unused-test
|
||||
|
Loading…
Reference in New Issue
Block a user