dead-code-detection 0.1.1 → 0.1.2

raw patch · 5 files changed

+55/−20 lines, 5 files

Files

• dead-code-detection.cabal +1/−1
• src/Ast.hs +20/−9
• src/GHC/Show.hs +3/−2
• test/AstSpec.hs +30/−7
• test/Helper.hs +1/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           dead-code-detection-version:        0.1.1+version:        0.1.2 synopsis:       detect dead code in haskell projects description:    detect dead code in haskell projects category:       Development

@@ -19,6 +19,7 @@ import           Data.Data import           Data.Generics.Uniplate.Data import           Data.List+import           Data.Maybe import qualified GHC import           GHC hiding (Module, moduleName) import           GHC.Paths (libdir)@@ -93,10 +94,16 @@         [Module _ Nothing declarations] ->           return $ boundNames declarations         [Module _ (Just exports) _] ->-          return $ concatMap (ieNames . unLoc) exports+          concat <$> mapM (extractExportedNames ast . unLoc) exports         [] -> Left ("cannot find module: " ++ moduleNameString name)         _ -> Left ("found module multiple times: " ++ moduleNameString name) +extractExportedNames :: Ast -> IE Name -> Either String [Name]+extractExportedNames ast = \ case+  IEModuleContents (unLoc -> moduleName) ->+    findExports ast [moduleName]+  x -> return $ ieNames x+ -- * name usage graph  usedTopLevelNames :: Ast -> Graph Name@@ -141,9 +148,7 @@  instance NameGraph (HsBindLR Name Name) where   nameGraph binding =-    map (, nub $ usedNames bn binding) bn-      where-        bn = boundNames binding+    map (, nub $ usedNames binding) (boundNames binding)  -- | extracts the bound names from ASTs class BoundNames ast where@@ -162,7 +167,7 @@   boundNames = \ case     FunBind id _ _ _ _ _ -> [unLoc id]     PatBind pat _ _ _ _ -> boundNames pat-    bind -> nyi bind+    bind -> nyi "HsBindLR" bind  instance BoundNames (Pat Name) where   boundNames = \ case@@ -170,11 +175,13 @@     ConPatIn _ p -> boundNames p     VarPat p -> [p]     TuplePat pats _ _ -> boundNames pats-    pat -> nyi pat+    WildPat _ -> []+    pat -> nyi "Pat" pat  instance BoundNames (HsConPatDetails Name) where   boundNames = \ case     PrefixCon args -> boundNames args+    InfixCon a b -> boundNames [a, b]     _ -> error "Not yet implemented: HsConPatDetails"  instance BoundNames (TyClGroup Name) where@@ -204,8 +211,12 @@       _ -> []      usedNamesBind :: HsBindLR Name Name -> [Name]-    usedNamesBind bind = usedNames (boundNames bind) bind+    usedNamesBind bind = usedNames bind  -- | extracts all used names from ASTs-usedNames :: [Name] -> HsBindLR Name Name -> [Name]-usedNames ids = filter (`notElem` ids) . universeBi+usedNames :: HsBindLR Name Name -> [Name]+usedNames = catMaybes . map extractHsVar . (universeBi :: HsBindLR Name Name -> [HsExpr Name])+  where+    extractHsVar :: HsExpr Name -> Maybe Name+    extractHsVar (HsVar n) = Just n+    extractHsVar _ = Nothing

@@ -21,5 +21,6 @@  -- * development utils -nyi :: Outputable doc => doc -> a-nyi = error . ("Not yet implemented: " ++) . showSDocUnsafe . ppr+nyi :: Outputable doc => String -> doc -> a+nyi msg x = error $+  ("Not yet implemented: " ++ msg ++ " " ++ (showSDocUnsafe $ ppr x))

@@ -61,7 +61,7 @@           |])       withModules [a, b] $ do         parseStringGraph ["A.hs", "B.hs"] `shouldReturn`-          Graph [("A.foo", []), ("B.bar", [])] []+          Graph [("A.foo", ["A.foo"]), ("B.bar", ["B.bar"])] []      it "does not create any files" $ do       withFooHeader [i|@@ -73,16 +73,17 @@         files `shouldMatchList` (words ". .. Foo.hs")    describe "findExports" $ do-    let find moduleFile moduleName = do-          Right ast <- parse [moduleFile]-          let Right exports = findExports ast moduleName+    let find moduleFiles moduleName = do+          ast <- either error id <$> parse moduleFiles+          let exports = either error id $+                findExports ast moduleName           return $ map showName exports     it "finds the names exported by a given module" $ do       withFooHeader [i|         foo = ()         bar = ()       |] $ do-        exports <- find "Foo.hs" [mkModuleName "Foo"]+        exports <- find ["Foo.hs"] [mkModuleName "Foo"]         exports `shouldMatchList` ["Foo.foo", "Foo.bar"]      context "when given a module with an export list" $ do@@ -93,9 +94,22 @@               bar = ()             |])         withModules [a] $ do-          exports <- find "A.hs" [mkModuleName "A"]+          exports <- find ["A.hs"] [mkModuleName "A"]           exports `shouldBe` ["A.foo"] +    it "includes identifiers exported by module" $ do+      let a = ("A", [i|+            module A (module B) where+            import B+          |])+          b = ("B", [i|+            module B where+            b = ()+          |])+      withModules [a, b] $ do+        exports <- find ["A.hs", "B.hs"] [mkModuleName "A"]+        exports `shouldBe` ["B.b"]+   describe "usedTopLevelNames" $ do     it "returns the graph of identifier usage" $ do       withFooHeader [i|@@ -158,7 +172,7 @@           (Just foo) = let x = x in x         |] $ do           parseStringGraph ["Foo.hs"] `shouldReturn`-            Graph [("Foo.foo", ["GHC.Base.Just"])] []+            Graph [("Foo.foo", [])] []        it "can parse tuple pattern binding" $ do         withFooHeader [i|@@ -166,3 +180,12 @@         |] $ do           parseStringGraph ["Foo.hs"] `shouldReturn`             Graph [("Foo.a", []), ("Foo.b", [])] []++    context "local variables" $ do+      it "recognizes recursive definitions" $ do+        withFooHeader [i|+          foo = foo+          bar = ()+        |] $ do+          parseStringGraph ["Foo.hs"] `shouldReturn`+            Graph [("Foo.bar", ["GHC.Tuple.()"]), ("Foo.foo", ["Foo.foo"])] []

@@ -21,7 +21,7 @@  withFooHeader :: String -> IO () -> IO () withFooHeader code =-  withFoo ("module Foo where\n" ++ code)+  withFoo ("module Foo where\n" ++ unindent code)  withModules :: [(String, String)] -> IO () -> IO () withModules modules action = do