dead-code-detection 0.5.1 → 0.6
raw patch · 10 files changed
+82/−12 lines, 10 files
Files
- dead-code-detection.cabal +3/−2
- src/Ast.hs +16/−4
- src/Ast/UsedNames.hs +1/−0
- src/Run.hs +8/−1
- src/Utils.hs +7/−1
- test/Ast/UsedNamesSpec.hs +4/−3
- test/AstSpec.hs +19/−0
- test/Main.hs +12/−0
- test/RunSpec.hs +11/−0
- test/Spec.hs +1/−1
dead-code-detection.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: dead-code-detection-version: 0.5.1+version: 0.6 synopsis: detect dead code in haskell projects description: detect dead code in haskell projects category: Development@@ -52,7 +52,7 @@ test-suite spec type: exitcode-stdio-1.0- main-is: Spec.hs+ main-is: Main.hs hs-source-dirs: test , src@@ -81,6 +81,7 @@ GraphSpec Helper RunSpec+ Spec Ast Ast.UsedNames Files
src/Ast.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-}@@ -15,12 +16,14 @@ import Bag import Control.Arrow ((>>>), second)+import Control.Exception import Control.Monad import Data.Data import Data.Generics.Uniplate.Data import qualified GHC import GHC hiding (Module, moduleName) import GHC.Paths (libdir)+import HscTypes import Name import Outputable import System.IO@@ -80,10 +83,18 @@ return $ Just $ map toModule typecheckedModules errorHandler :: IO (Maybe a) -> IO (Either String a)-errorHandler action = do- (errs, a) <- hCapture [stderr] action- return $ maybe (Left errs) Right a+errorHandler action =+ catchSourceError $+ captureStderr action+ where+ captureStderr action = do+ (errs, a) <- hCapture [stderr] action+ return $ maybe (Left errs) Right a + catchSourceError :: IO (Either String a) -> IO (Either String a)+ catchSourceError = handle $ \ (e :: SourceError) ->+ return $ Left $ show e+ findExports :: Ast -> [ModuleName] -> Either String [Name] findExports ast names = concat <$> mapM inner names where@@ -136,7 +147,7 @@ instance NameGraph (HsGroup Name) where nameGraph = \ case- HsGroup valBinds [] tyclds _instances _standaloneInstances [] [] foreign_decls [] [] [] [] [] ->+ HsGroup valBinds [] tyclds _instances _standaloneInstances [] [] foreign_decls [] _annotations [] [] [] -> nameGraph valBinds ++ nameGraph tyclds ++ nameGraph foreign_decls@@ -165,6 +176,7 @@ VarPat p -> withoutUsedNames [p] TuplePat pats _ _ -> nameGraph pats WildPat _ -> []+ LazyPat p -> nameGraph p pat -> errorNyiOutputable pat instance NameGraph (TyClGroup Name) where
src/Ast/UsedNames.hs view
@@ -53,6 +53,7 @@ BangPat pat -> usedNames pat NPat{} -> [] LitPat{} -> []+ LazyPat pat -> usedNames pat x -> errorNyiOutputable x instance UsedNames (HsConDetails (LPat Name) (HsRecFields Name (LPat Name))) where
src/Run.hs view
@@ -19,6 +19,7 @@ import GHC.Show import Graph import qualified Paths_dead_code_detection as Paths+import Utils data Options = Options {@@ -66,7 +67,7 @@ deadNamesFromFiles files roots includeUnderscoreNames = do ast <- parse files case ast of- Left err -> die err+ Left err -> die $ ghcError err Right ast -> case findExports ast roots of Left err -> die err Right rootExports -> do@@ -75,6 +76,12 @@ removeConstructorNames $ filterUnderScoreNames includeUnderscoreNames $ deadNames graph rootExports+ where+ ghcError message = stripSpaces $ unlines $+ "Some of the input files produce compile errors." :+ "ghc says:" :+ map (" " ++) (lines message) +++ [] filterUnderScoreNames :: Bool -> [Name] -> [Name] filterUnderScoreNames include = if include then id else
src/Utils.hs view
@@ -2,6 +2,7 @@ module Utils where +import Data.Char import Data.Set nubOrd :: forall a . Ord a => [a] -> [a]@@ -14,7 +15,7 @@ inner _ [] = [] errorNyi :: String -> a-errorNyi message = error $ unlines $+errorNyi message = error $ stripSpaces $ unlines $ "Encountered a language construct that is" : "not yet implemented. Please consider opening a bug report about" : "this here: https://github.com/soenkehahn/dead-code-detection/issues" :@@ -22,3 +23,8 @@ "Here's some debugging output that will probably help to solve this problem:" : message : []++stripSpaces :: String -> String+stripSpaces =+ reverse . dropWhile isSpace .+ reverse . dropWhile isSpace
test/Ast/UsedNamesSpec.hs view
@@ -10,17 +10,18 @@ spec :: Spec spec = do- let errs =+ let errs :: [(String, ())]+ errs = ("errorNyiData", errorNyiData ()) : ("errorNyiOutputable", errorNyiOutputable ()) : [] forM_ errs $ \ (name, err) -> do describe name $ do it "explains that this is not yet implemented" $ do- err () `shouldThrow` \ (ErrorCall message) ->+ seq err (return ()) `shouldThrow` \ (ErrorCall message) -> "not yet implemented" `isInfixOf` message it "points to the issue tracker" $ do- err () `shouldThrow` \ (ErrorCall message) ->+ seq err (return ()) `shouldThrow` \ (ErrorCall message) -> "https://github.com/soenkehahn/dead-code-detection/issues" `isInfixOf` message
test/AstSpec.hs view
@@ -31,6 +31,11 @@ result <- parse ["Foo.hs"] void result `shouldBe` Left "\nFoo.hs:2:7: Not in scope: ‘bar’\n" + it "handles missing modules gracefully" $ do+ withFooHeader "import Bar" $ do+ Left message <- parse ["Foo.hs"]+ message `shouldContain` "Could not find module ‘Bar’"+ it "doesn't output error messages" $ do withFoo "foo = bar" $ do output <- hCapture_ [stdout, stderr] $ parse ["Foo.hs"]@@ -175,6 +180,13 @@ |] $ do (usageGraph <$> parseStringGraph ["Foo.hs"]) `shouldReturn` [("Foo.Foo", [])] + it "ignores annotations" $ do+ withFooHeader [i|+ {-# ANN foo "annotation" #-}+ foo = 42+ |] $ do+ (usageGraph <$> parseStringGraph ["Foo.hs"]) `shouldReturn` [("Foo.foo",[])]+ context "PatBind" $ do it "can parse pattern binding" $ do withFooHeader [i|@@ -186,6 +198,13 @@ it "can parse tuple pattern binding" $ do withFooHeader [i| (a, b) = let x = x in x+ |] $ do+ parseStringGraph ["Foo.hs"] `shouldReturn`+ Graph [("Foo.a", []), ("Foo.b", [])] []++ it "can parse lazy patterns" $ do+ withFooHeader [i|+ ~(a, b) = let x = x in x |] $ do parseStringGraph ["Foo.hs"] `shouldReturn` Graph [("Foo.a", []), ("Foo.b", [])] []
+ test/Main.hs view
@@ -0,0 +1,12 @@++module Main where++import GHC (runGhc)+import GHC.Paths (libdir)++import qualified Spec++main :: IO ()+main = do+ runGhc (Just libdir) (return ())+ Spec.main
test/RunSpec.hs view
@@ -58,6 +58,17 @@ output `shouldContain` "version: " describe "deadNamesFromFiles" $ do+ it "should clearly mark ghc's output as such" $ do+ let a = ("A", [i|+ module A where+ import B+ |])+ withModules [a] $ do+ output <- hCapture_ [stderr] $+ deadNamesFromFiles ["A.hs"] [mkModuleName "A"] False+ `shouldThrow` (== ExitFailure 1)+ output `shouldContain` "ghc says:"+ it "can be run on multiple modules" $ do let a = ("A", [i| module A where
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}