haskell-tools-experimental-refactorings 1.0.0.4 → 1.0.1.1

raw patch · 9 files changed

+72/−15 lines, 9 filesdep ~CabalPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor/Builtin/DollarApp.hs +2/−1
• Language/Haskell/Tools/Refactor/Builtin/DollarApp1.hs +2/−1
• Language/Haskell/Tools/Refactor/Builtin/DollarApp2.hs +2/−1
• Language/Haskell/Tools/Refactor/Builtin/DollarApp3.hs +2/−1
• Language/Haskell/Tools/Refactor/Builtin/FindUnused.hs +51/−0
• Language/Haskell/Tools/Refactor/Builtin/HelloRefactor.hs +2/−1
• Language/Haskell/Tools/Refactor/Builtin/IfToGuards.hs +2/−1
• haskell-tools-experimental-refactorings.cabal +7/−6
• test/Main.hs +2/−3

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, ConstraintKinds, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.DollarApp (dollarApp, tryItOut) where
 
 import Language.Haskell.Tools.Refactor

@@ -1,4 +1,5 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.DollarApp1 where
 
 import Language.Haskell.Tools.Refactor

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.DollarApp2 where
 
 import Language.Haskell.Tools.Refactor

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, ConstraintKinds, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.DollarApp3 where
 
 import Language.Haskell.Tools.Refactor

@@ -0,0 +1,51 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, TemplateHaskell, TupleSections #-}
+
+module Language.Haskell.Tools.Refactor.Builtin.FindUnused where
+
+import Language.Haskell.Tools.PrettyPrint (prettyPrint)
+import Language.Haskell.Tools.Refactor
+
+import GHC
+import Name
+import Data.Set (Set, empty, (\\), toList, insert)
+import Data.List (intercalate, groupBy)
+import Data.Function (on)
+import Control.Reference
+import Control.Monad.State
+import Debug.Trace (trace)
+import Outputable (ppr, showSDocUnsafe)
+
+data UnusedState = UnusedState { _defined :: Set GHC.Name
+                               , _used :: Set GHC.Name
+                               }
+
+initState = UnusedState empty empty
+
+makeReferences ''UnusedState
+
+findUnusedRefactoring :: RefactoringChoice
+findUnusedRefactoring = ProjectRefactoring "FindUnused" findUnused
+
+findUnused :: ProjectRefactoring
+findUnused mods = do let (mod', st) = flip runState initState $ mapM (biplateRef !~ recordName) (map snd mods)
+                         unused = toList ((st ^. defined) \\ (st ^. used))
+                     unusedDefs <- filterM (fmap not . isRecordName) unused
+                     let groupedUnused = groupBy ((==) `on` nameModule_maybe) unusedDefs
+                     liftIO $ putStrLn $ "Unused definitions:"
+                     liftIO $ putStrLn
+                            $ unlines
+                            $ map (\ls -> (showSDocUnsafe $ ppr $ nameModule_maybe (head ls)) ++ ": "
+                                             ++ intercalate ", " (map (showSDocUnsafe . ppr) ls)) 
+                            $ groupedUnused
+                     return [] -- no changes
+  where isRecordName n = do tt <- lookupName n
+                            case tt of Just (AnId id) -> return $ isRecordSelector id
+                                       _ -> return False
+
+recordName :: QualifiedName -> State UnusedState QualifiedName
+recordName n = do let name = semanticsName n
+                      isDefined = semanticsDefining n 
+                  case name of Just semaName -> if isDefined then modify $ defined .- insert semaName
+                                                             else modify $ used .- insert semaName
+                               Nothing -> return ()
+                  return $ trace ("\n### Name: " ++ prettyPrint n ++ " " ++ show isDefined) $ n

@@ -1,4 +1,5 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.HelloRefactor where
 
 import Language.Haskell.Tools.PrettyPrint (prettyPrint)

@@ -1,4 +1,5 @@-{-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MonoLocalBinds, RankNTypes #-}
+
 module Language.Haskell.Tools.Refactor.Builtin.IfToGuards (ifToGuards, tryItOut) where
 
 import Control.Reference ((^.), (.-), (&))

@@ -1,5 +1,5 @@ name:                haskell-tools-experimental-refactorings
-version:             1.0.0.4
+version:             1.0.1.1
 synopsis:            Refactoring Tool for Haskell
 description:         Contains experimental refactorings implemented in the Haskell-tools framework for tutorial purposes, or to be added later to the set of mature refactorings.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -23,8 +23,9 @@                      , Language.Haskell.Tools.Refactor.Builtin.DollarApp1
                      , Language.Haskell.Tools.Refactor.Builtin.DollarApp2
                      , Language.Haskell.Tools.Refactor.Builtin.DollarApp3
+                     , Language.Haskell.Tools.Refactor.Builtin.FindUnused
 
-  build-depends:       base                      >= 4.10  && < 4.11
+  build-depends:       base                      >= 4.10 && < 4.11
                      , mtl                       >= 2.2  && < 2.3
                      , uniplate                  >= 1.6  && < 1.7
                      , ghc-paths                 >= 0.1  && < 0.2
@@ -36,7 +37,7 @@                      , filepath                  >= 1.4  && < 1.5
                      , template-haskell          >= 2.12 && < 2.13
                      , ghc                       >= 8.2  && < 8.3
-                     , Cabal                     >= 2.0 && < 2.1
+                     , Cabal                     >= 2.0  && < 2.3
                      , haskell-tools-ast         >= 1.0  && < 1.1
                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
                      , haskell-tools-rewrite     >= 1.0  && < 1.1
@@ -49,9 +50,9 @@   ghc-options:         -with-rtsopts=-M2g
   hs-source-dirs:      test
   main-is:             Main.hs
-  build-depends:       base                      >= 4.10  && < 4.11
+  build-depends:       base                      >= 4.10 && < 4.11
                      , tasty                     >= 0.11 && < 1.1
-                     , tasty-hunit               >= 0.9 && < 0.11
+                     , tasty-hunit               >= 0.9  && < 0.11
                      , transformers              >= 0.5  && < 0.6
                      , either                    >= 4.4  && < 5.1
                      , filepath                  >= 1.4  && < 1.5
@@ -65,7 +66,7 @@                      , template-haskell          >= 2.12 && < 2.13
                      , ghc                       >= 8.2  && < 8.3
                      , ghc-paths                 >= 0.1  && < 0.2
-                     , Cabal                     >= 2.0 && < 2.1
+                     , Cabal                     >= 2.0  && < 2.3
                      , haskell-tools-ast         >= 1.0  && < 1.1
                      , haskell-tools-backend-ghc >= 1.0  && < 1.1
                      , haskell-tools-rewrite     >= 1.0  && < 1.1

@@ -1,6 +1,5 @@-{-# LANGUAGE LambdaCase
-           , TypeFamilies
-           #-}
+{-# LANGUAGE LambdaCase, MonoLocalBinds #-}
+
 module Main where
 
 import Test.Tasty (TestTree, testGroup, defaultMain)