Warn on missing ignored files and detect ignored files better

dead-code-detection.cabal

@@ -1,4 +1,4 @@
--- This file has been generated from package.yaml by hpack version 0.13.0.
+-- This file has been generated from package.yaml by hpack version 0.14.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -40,6 +40,7 @@ executable dead-code-detection
     , uniplate
     , ghc-paths
     , gitrev
+    , directory
   other-modules:
       Ast
       Ast.UsedNames
@@ -69,11 +70,11 @@ test-suite spec
     , uniplate
     , ghc-paths
     , gitrev
+    , directory
     , hspec
     , mockery
     , interpolate
     , filepath
-    , directory
   other-modules:
       Ast.UsedNamesSpec
       AstSpec

package.yaml

@@ -24,6 +24,7 @@ dependencies:
   - uniplate
   - ghc-paths
   - gitrev
+  - directory
 
 executables:
   dead-code-detection:
@@ -43,4 +44,3 @@ tests:
       - mockery
       - interpolate
       - filepath
-      - directory

src/Run.hs

@@ -11,6 +11,7 @@ import           Development.GitRev
 import           FastString
 import           GHC
 import           OccName
+import           System.Directory
 import           System.Exit
 import           WithCli
 
@@ -43,8 +44,8 @@ run = do
       throwIO ExitSuccess
     when (null $ root options) $
       die "missing option: --root=STRING"
-    files <- filter (`notElem` ignore options) <$>
-      findHaskellFiles (sourceDirs options)
+    files <- findHaskellFiles (sourceDirs options)
+      >>= filterNotIgnored (ignore options)
     deadNames <- deadNamesFromFiles
       files
       (map mkModuleName (root options))
@@ -66,6 +67,30 @@ versionOutput =
            "branch: " ++ $(gitBranch)
       else "version: " ++ showVersion Paths.version
 
+filterNotIgnored :: [FilePath] -> [FilePath] -> IO [FilePath]
+filterNotIgnored ignored files = do
+  ignoredCanonicalized <- mapM safeCanonicalize ignored
+  forFilterM files $ \ file -> do
+    canonicalized <- safeCanonicalize file
+    return $ not (canonicalized `elem` ignoredCanonicalized)
+
+safeCanonicalize :: FilePath -> IO FilePath
+safeCanonicalize file = do
+  exists <- doesFileExist file
+  when (not exists) $ do
+    die ("file not found: " ++ file)
+  canonicalizePath file
+
+forFilterM :: Monad m => [a] -> (a -> m Bool) -> m [a]
+forFilterM list pred = case list of
+  (a : r) -> do
+    cond <- pred a
+    rest <- forFilterM r pred
+    if cond
+      then return (a : rest)
+      else return rest
+  [] -> return []
+
 deadNamesFromFiles :: [FilePath] -> [ModuleName] -> Bool -> IO [String]
 deadNamesFromFiles files roots includeUnderscoreNames = do
   ast <- parse files

test/RunSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module RunSpec where
 
@@ -32,7 +33,7 @@ spec = do
 
       it "exits with a non-zero exit-code" $ do
         withModules [main] $ do
-          run' `shouldThrow` (== ExitFailure 1)
+          run' `shouldDie` ""
 
     it "allows to set multiple roots" $ do
       let a = ("A", [i|
@@ -57,16 +58,37 @@ spec = do
         withArgs ["--version"] run
       output `shouldContain` "version: "
 
-    it "ignores files if told to do so" $ do
-      let main = ("Main", [i|
-            module Main where
-            main = return ()
-          |])
-          b = ("B", [i|
-            This is some arbitrary text that is not Haskell.
+    context "--ignore" $ do
+
+      it "ignores files if told to do so" $ do
+        let main = ("Main", [i|
+              module Main where
+              main = return ()
             |])
-          run' = withArgs (words "-i. -e./B.hs --root Main") run
-      withModules [main, b] $ run' `shouldReturn` ()
+            b = ("B", [i|
+              This is some arbitrary text that is not Haskell.
+              |])
+            run' = withArgs (words "-i. -e./B.hs --root Main") run
+        withModules [main, b] $ run' `shouldReturn` ()
+
+      it "errors out on missing ignored files" $ do
+        let main = ("Main", [i|
+              module Main where
+              main = return ()
+            |])
+            run' = withArgs (words "-i. -e./B.hs --root Main") run
+        withModules [main] $ run' `shouldDie` "file not found: ./B.hs\n"
+
+      it "ignores files if referenced differently" $ do
+        let main = ("Main", [i|
+              module Main where
+              main = return ()
+            |])
+            b = ("B", [i|
+              This is some arbitrary text that is not Haskell.
+              |])
+            run' = withArgs (words "-i. -e B.hs --root Main") run
+        withModules [main, b] $ run' `shouldReturn` ()
 
   describe "deadNamesFromFiles" $ do
     it "should clearly mark ghc's output as such" $ do
@@ -137,3 +159,14 @@ spec = do
       withModules [a, b] $ do
         dead <- deadNamesFromFiles ["A.hs", "B.hs"] [mkModuleName "A"] False
         dead `shouldMatchList` ["A.hs:4:1: bar", "B.hs:2:1: baz"]
+
+shouldDie :: IO a -> String -> IO ()
+shouldDie action err = do
+  (output, exception) <- hCapture [stderr] $ catch
+    (action >> return Nothing)
+    (\ (e :: ExitCode) -> return $ Just e)
+  case exception of
+    Nothing -> throwIO $ ErrorCall "shouldDie: didn't receive ExitCode exception"
+    Just ExitSuccess -> throwIO $ ErrorCall "shouldDie: received ExitSuccess exception"
+    Just (ExitFailure _) ->
+      output `shouldBe` err