dead-code-detection 0.7 → 0.8

raw patch · 3 files changed

+74/−15 lines, 3 files

Files

• dead-code-detection.cabal +4/−3
• src/Run.hs +27/−2
• test/RunSpec.hs +43/−10

@@ -1,9 +1,9 @@--- 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  name:           dead-code-detection-version:        0.7+version:        0.8 synopsis:       detect dead code in haskell projects description:    detect dead code in haskell projects category:       Development@@ -40,6 +40,7 @@     , uniplate     , ghc-paths     , gitrev+    , directory   other-modules:       Ast       Ast.UsedNames@@ -69,11 +70,11 @@     , uniplate     , ghc-paths     , gitrev+    , directory     , hspec     , mockery     , interpolate     , filepath-    , directory   other-modules:       Ast.UsedNamesSpec       AstSpec

@@ -11,6 +11,7 @@ import           FastString import           GHC import           OccName+import           System.Directory import           System.Exit import           WithCli @@ -43,8 +44,8 @@       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))@@ -65,6 +66,30 @@            "rev: " ++ $(gitHash) ++ (if $(gitDirty) then " (dirty)" else "") ++ "\n" ++            "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

@@ -1,4 +1,5 @@ {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}  module RunSpec where @@ -32,7 +33,7 @@        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,17 +58,38 @@         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       let a = ("A", [i|@@ -137,3 +159,14 @@       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