Filter results to matches with one file and one occurrence

app/Main.hs

@@ -10,11 +10,12 @@ main :: IO ()
 main = do
     terms <- pure . lines =<< getContents
     results <- pure . concat =<< mapM search terms
+    let response = responseFromParse $ parseLines $ unlines results
 
-    case parseLines $ unlines results of
-        ValidParse termMatchSet ->
+    case withOneOccurrence $ withOneFile response of
+        Right termMatchSet ->
             mapM_ printMatchPair $ toList termMatchSet
-        InvalidParse e -> do
+        Left e -> do
             setSGR [SetColor Background Vivid Red]
             setSGR [SetColor Foreground Vivid White]
             setSGR [SetConsoleIntensity BoldIntensity]

src/Unused/Parser.hs

@@ -3,16 +3,14 @@ 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 -> ParseResponse
-parseLines s =
-    either InvalidParse (ValidParse . fromList . groupBy term) $
-        parse parseTermMatches "matches" s
+parseLines :: String -> Either ParseError [TermMatch]
+parseLines =
+    parse parseTermMatches "matches"
 
 parseTermMatches :: Parser [TermMatch]
 parseTermMatches = do
@@ -39,7 +37,7 @@ parseTermMatch = do
     colonSep = do { void $ try $ char ':' }
 
 termChars :: Parser Char
-termChars = alphaNum <|> char '_' <|> char '!' <|> char '?' <|> char '='
+termChars = choice [alphaNum, char '_', char '!', char '?', char '=', char '>', char '<']
 
 termParser :: Parser String
 termParser = many1 termChars
@@ -56,10 +54,3 @@ eol = try (string "\n\r")
     <|> string "\n"
     <|> 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

src/Unused/Types.hs

@@ -2,10 +2,15 @@ module Unused.Types
     ( TermMatch(..)
     , TermMatchSet
     , ParseResponse(..)
+    , responseFromParse
+    , withOneFile
+    , withOneOccurrence
     ) where
 
 import Text.Parsec (ParseError)
-import Data.Map.Strict as Map
+import qualified Data.Map.Strict as Map
+import Data.List (isInfixOf)
+import Unused.Util (groupBy)
 
 data TermMatch = TermMatch
     { term :: String
@@ -13,6 +18,20 @@ data TermMatch = TermMatch
     , occurrences :: Int
     } deriving Show
 
-type TermMatchSet = Map String [TermMatch]
+type TermMatchSet = Map.Map String [TermMatch]
 
-data ParseResponse = ValidParse TermMatchSet | InvalidParse ParseError
+type ParseResponse = Either ParseError TermMatchSet
+
+responseFromParse :: Either ParseError [TermMatch] -> ParseResponse
+responseFromParse =
+    fmap $ Map.fromList . groupBy term
+
+withOneFile :: ParseResponse -> ParseResponse
+withOneFile = fmap $ Map.filterWithKey (\_ a -> length a == 1)
+
+withOneOccurrence :: ParseResponse -> ParseResponse
+withOneOccurrence = fmap $ Map.filterWithKey (\_ a -> (sum $ fmap occurrences a) == 1)
+
+notMatchingPath :: String -> ParseResponse -> ParseResponse
+notMatchingPath s =
+    fmap $ Map.map $ filter (not . isInfixOf s . path)

src/Unused/Util.hs

@@ -0,0 +1,12 @@
+module Unused.Util
+    ( groupBy
+    ) where
+
+import Data.List (nub)
+
+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

unused.cabal

@@ -18,6 +18,7 @@ library
   exposed-modules:     Unused.TermSearch
                      , Unused.Parser
                      , Unused.Types
+                     , Unused.Util
   build-depends:       base >= 4.7 && < 5
                      , process
                      , parsec