mirror of
https://github.com/joshuaclayton/unused.git
synced 2024-09-11 04:45:28 +03:00
Reorganize data structure to handle parsing errors
This extracts the previous data structure from groupBy into an actual Data.Map.Strict String [TermMatch], as well as another type (ParseResponse) capturing invalid and valid responses.
This commit is contained in:
parent
ed72d2405a
commit
2d4939cb47
30
app/Main.hs
30
app/Main.hs
@ -1,18 +1,35 @@
|
||||
module Main where
|
||||
|
||||
import System.Console.ANSI
|
||||
import Data.List (nub)
|
||||
import Unused.TermSearch (search)
|
||||
import Unused.Parser (parseLines)
|
||||
import Unused.Types
|
||||
import Data.Map.Strict (toList)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
terms <- pure . lines =<< getContents
|
||||
results <- pure . concat =<< mapM search terms
|
||||
let groupedMatches = groupBy term $ parseLines $ unlines results
|
||||
|
||||
mapM_ printMatchPair groupedMatches
|
||||
case parseLines $ unlines results of
|
||||
ValidParse termMatchSet ->
|
||||
mapM_ printMatchPair $ toList termMatchSet
|
||||
InvalidParse e -> do
|
||||
setSGR [SetColor Background Vivid Red]
|
||||
setSGR [SetColor Foreground Vivid White]
|
||||
setSGR [SetConsoleIntensity BoldIntensity]
|
||||
|
||||
putStrLn "\nThere was a problem parsing the data:\n"
|
||||
|
||||
setSGR [Reset]
|
||||
|
||||
setSGR [SetColor Foreground Vivid Red]
|
||||
setSGR [SetConsoleIntensity BoldIntensity]
|
||||
|
||||
print e
|
||||
putStr "\n"
|
||||
|
||||
setSGR [Reset]
|
||||
|
||||
return ()
|
||||
|
||||
@ -36,10 +53,3 @@ printMatches matches = do
|
||||
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
|
||||
|
@ -3,13 +3,16 @@ module Unused.Parser
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.List (nub)
|
||||
import Data.Map.Strict (fromList)
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec
|
||||
import Unused.Types
|
||||
|
||||
parseLines :: String -> [TermMatch]
|
||||
parseLines :: String -> ParseResponse
|
||||
parseLines s =
|
||||
either (const []) id $ parse parseTermMatches "matches" s
|
||||
either InvalidParse (ValidParse . fromList . groupBy term) $
|
||||
parse parseTermMatches "matches" s
|
||||
|
||||
parseTermMatches :: Parser [TermMatch]
|
||||
parseTermMatches = do
|
||||
@ -42,7 +45,7 @@ termParser :: Parser String
|
||||
termParser = many1 termChars
|
||||
|
||||
pathParser :: Parser String
|
||||
pathParser = many1 $ alphaNum <|> char '.' <|> char '/' <|> char '_' <|> char '-'
|
||||
pathParser = many1 (noneOf ":")
|
||||
|
||||
occurrenceParser :: Parser String
|
||||
occurrenceParser = many1 digit
|
||||
@ -54,3 +57,9 @@ eol = try (string "\n\r")
|
||||
<|> string "\r"
|
||||
<?> "end of line"
|
||||
|
||||
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
|
||||
|
@ -1,9 +1,18 @@
|
||||
module Unused.Types
|
||||
( TermMatch(..)
|
||||
, TermMatchSet
|
||||
, ParseResponse(..)
|
||||
) where
|
||||
|
||||
import Text.Parsec (ParseError)
|
||||
import Data.Map.Strict as Map
|
||||
|
||||
data TermMatch = TermMatch
|
||||
{ term :: String
|
||||
, path :: String
|
||||
, occurrences :: Int
|
||||
} deriving Show
|
||||
|
||||
type TermMatchSet = Map String [TermMatch]
|
||||
|
||||
data ParseResponse = ValidParse TermMatchSet | InvalidParse ParseError
|
||||
|
@ -21,6 +21,7 @@ library
|
||||
build-depends: base >= 4.7 && < 5
|
||||
, process
|
||||
, parsec
|
||||
, containers
|
||||
default-language: Haskell2010
|
||||
|
||||
executable unused
|
||||
@ -30,6 +31,7 @@ executable unused
|
||||
build-depends: base
|
||||
, unused
|
||||
, ansi-terminal
|
||||
, containers
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite unused-test
|
||||
|
Loading…
Reference in New Issue
Block a user