packages feed

dead-code-detection 0.5 → 0.5.1

raw patch · 7 files changed

+67/−27 lines, 7 files

Files

README.md view
@@ -2,6 +2,15 @@  `dead-code-detection` detects dead code in haskell projects. +This project is still in an early stage. Currently only those language+constructs have been implemented that I have stumbled across in projects I used+it on. If the tool encounters a language construct that it doesn't understand+yet, it will crash. (I *think* this is the best behavior since ignoring+unimplemented language constructs would easily result in false positives and+false negatives.) If you use `dead-code-detection` on any project and it+doesn't work due to a not implemented language construct, please consider+opening an issue on github.+ ``` shell $ dead-code-detection --root Main -isrc src/Example/Module.hs:42:23: unusedName
dead-code-detection.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           dead-code-detection-version:        0.5+version:        0.5.1 synopsis:       detect dead code in haskell projects description:    detect dead code in haskell projects category:       Development@@ -75,6 +75,7 @@     , filepath     , directory   other-modules:+      Ast.UsedNamesSpec       AstSpec       FilesSpec       GraphSpec
src/Ast.hs view
@@ -27,7 +27,6 @@ import           System.IO.Silently  import           Ast.UsedNames-import           GHC.Show import           Graph  type Ast = [Module]@@ -141,12 +140,12 @@       nameGraph valBinds ++       nameGraph tyclds ++       nameGraph foreign_decls-    x -> o x+    x -> errorNyiOutputable x  instance NameGraph (ForeignDecl Name) where   nameGraph = \ case     ForeignImport name _ _ _ -> [(unLoc name, [])]-    x -> o x+    x -> errorNyiOutputable x  instance NameGraph (HsValBinds Name) where   nameGraph = \ case@@ -157,7 +156,7 @@   nameGraph bind = addUsedNames (usedNames bind) $ case bind of     FunBind id _ _ _ _ _ -> withoutUsedNames [unLoc id]     PatBind pat _ _ _ _ -> nameGraph pat-    x -> o x+    x -> errorNyiOutputable x  instance NameGraph (Pat Name) where   nameGraph = \ case@@ -166,19 +165,19 @@     VarPat p -> withoutUsedNames [p]     TuplePat pats _ _ -> nameGraph pats     WildPat _ -> []-    pat -> nyi "Pat" pat+    pat -> errorNyiOutputable pat  instance NameGraph (TyClGroup Name) where   nameGraph = \ case     TyClGroup decls [] -> nameGraph decls-    x -> o x+    x -> errorNyiOutputable x  instance NameGraph (TyClDecl Name) where   nameGraph = \ case     DataDecl _typeCon _ def _ -> nameGraph def     ClassDecl{} -> []     SynDecl{} -> []-    x -> o x+    x -> errorNyiOutputable x  instance NameGraph (HsDataDefn Name) where   nameGraph = \ case@@ -194,7 +193,7 @@   nameGraph = \ case     RecCon rec -> nameGraph rec     PrefixCon _ -> []-    x -> e x+    x -> errorNyiData x  instance NameGraph (ConDeclField Name) where   nameGraph = \ case@@ -205,7 +204,7 @@   nameGraph = \ case     PrefixCon args -> nameGraph args     InfixCon a b -> nameGraph a ++ nameGraph b-    _ -> error "Not yet implemented: HsConPatDetails"+    x -> errorNyiData x  -- | extracts names used in instance declarations getClassMethodUsedNames :: Ast -> [Name]
src/Ast/UsedNames.hs view
@@ -8,6 +8,7 @@ import           Data.Data import           GHC import           Outputable+import           Utils  class UsedNames ast where   -- | extracts all used names from ASTs@@ -27,7 +28,7 @@     FunBind _ _ matches _ _ _ -> usedNames matches     PatBind lhs rhs _ _ _ ->       usedNames lhs ++ usedNames rhs-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (MatchGroup Name (LHsExpr Name)) where   usedNames = usedNames . mg_alts@@ -52,7 +53,7 @@     BangPat pat -> usedNames pat     NPat{} -> []     LitPat{} -> []-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (HsConDetails (LPat Name) (HsRecFields Name (LPat Name))) where   usedNames = \ case@@ -76,7 +77,7 @@     LastStmt expr _ -> usedNames expr     BodyStmt expr _ _ _ -> usedNames expr     LetStmt x -> usedNames x-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (HsExpr Name) where   usedNames = \ case@@ -110,7 +111,7 @@     ArithSeq _ _ info -> usedNames info     RecordCon constructor _ binds ->       unLoc constructor : usedNames binds-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (ArithSeqInfo Name) where   usedNames = \ case@@ -129,19 +130,19 @@     MDoExpr -> []     ArrowExpr -> []     GhciStmtCtxt -> []-    x -> e x+    x -> errorNyiData x  instance UsedNames (HsLocalBinds Name) where   usedNames = \ case     EmptyLocalBinds -> []     HsValBinds binds -> usedNames binds-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (HsValBindsLR Name Name) where   usedNames = \ case     ValBindsOut (map snd -> binds) _sig ->       usedNames binds-    x -> o x+    x -> errorNyiOutputable x  instance UsedNames (HsTupArg Name) where   usedNames = \ case@@ -156,14 +157,14 @@   usedNames (HsRecField assigned expr _) =     unLoc assigned : usedNames expr -e :: (Data a) => a -> b-e x = error $ ("e: " ++ ) $ unlines $+errorNyiData :: (Data a) => a -> b+errorNyiData x = errorNyi $ ("errorNyiData: " ++ ) $ unlines $   dataTypeName (dataTypeOf x) :   show (toConstr x) :   [] -o :: (Outputable a, Data a) => a -> b-o x = error $ ("o: " ++) $ unlines $+errorNyiOutputable :: (Outputable a, Data a) => a -> b+errorNyiOutputable x = errorNyi $ ("errorNyiOutputable: " ++) $ unlines $   dataTypeName (dataTypeOf x) :   show (toConstr x) :   showSDocUnsafe (ppr x) :
src/GHC/Show.hs view
@@ -18,9 +18,3 @@         show (srcLocLine loc) ++ ":" ++         show (srcLocCol loc)       UnhelpfulLoc s -> cs (fs_bs s)---- * development utils--nyi :: Outputable doc => String -> doc -> a-nyi msg x = error $-  ("Not yet implemented: " ++ msg ++ " " ++ (showSDocUnsafe $ ppr x))
src/Utils.hs view
@@ -12,3 +12,13 @@       | a `member` acc = inner acc r       | otherwise = a : inner (insert a acc) r     inner _ [] = []++errorNyi :: String -> a+errorNyi message = error $ 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" :+  "" :+  "Here's some debugging output that will probably help to solve this problem:" :+  message :+  []
+ test/Ast/UsedNamesSpec.hs view
@@ -0,0 +1,26 @@++module Ast.UsedNamesSpec where++import           Control.Exception+import           Data.Foldable+import           Data.List+import           Test.Hspec++import           Ast.UsedNames++spec :: Spec+spec = do+  let 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) ->+          "not yet implemented" `isInfixOf` message++      it "points to the issue tracker" $ do+        err () `shouldThrow` \ (ErrorCall message) ->+          "https://github.com/soenkehahn/dead-code-detection/issues" `isInfixOf`+            message