From 5be067eabad0cf263cecf37958d7ce50e2145dcd Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 17 Nov 2020 12:11:30 +0100 Subject: [PATCH 01/24] Use last apply-refact for cabal --- cabal.project | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cabal.project b/cabal.project index 4f273244d5..2b90ddaf47 100644 --- a/cabal.project +++ b/cabal.project @@ -14,6 +14,11 @@ packages: ./plugins/hls-haddock-comments-plugin ./plugins/hls-splice-plugin +source-repository-package + type: git + location: https://github.com/mpickering/apply-refact.git + tag: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d + tests: true package * From cf508ba0deb3a3ebcffc6835b4392d80afb67abf Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 21 Nov 2020 22:19:07 +0100 Subject: [PATCH 02/24] Add ghc-exactprint as dependency --- plugins/hls-hlint-plugin/hls-hlint-plugin.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index e761e539fe..50243d3aa5 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -38,6 +38,7 @@ library , directory , extra , filepath + , ghc-exactprint , ghcide , hashable , haskell-lsp From 9b6395f471b05f6be61eadca889d11c50cb7a512 Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 21 Nov 2020 22:19:24 +0100 Subject: [PATCH 03/24] Leverage apply-refact improvements * applyRefactoring accepts ghc extensions to parse the file * new applyRefactoring' function accepts the parsed module Thanks @zliu41! --- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 75 +++++++++++++------ 1 file changed, 51 insertions(+), 24 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 8aa247399b..b4392dd106 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -39,12 +40,16 @@ import Development.IDE.Core.Shake (getDiagnostics) #ifdef GHC_LIB import Data.List (nub) import "ghc-lib" GHC hiding (DynFlags(..)) +import "ghc-lib" GHC.LanguageExtension (Extension) import "ghc" GHC as RealGHC (DynFlags(..)) import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags) import qualified "ghc" EnumSet as EnumSet import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension) #else import Development.IDE.GHC.Compat hiding (DynFlags(..)) +import HscTypes (hsc_dflags) +import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) +import Language.Haskell.GHC.ExactPrint.Delta (normalLayout) #endif import Ide.Logger @@ -176,7 +181,14 @@ getIdeas nfp = do fmap applyHints' (moduleEx flags) where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx)) -#ifdef GHC_LIB +#ifndef GHC_LIB + moduleEx _flags = do + mbpm <- getParsedModule nfp + return $ createModule <$> mbpm + where createModule pm = Right (createModuleEx anns modu) + where anns = pm_annotations pm + modu = pm_parsed_source pm +#else moduleEx flags = do mbpm <- getParsedModule nfp -- If ghc was not able to parse the module, we disable hlint diagnostics @@ -190,20 +202,18 @@ getIdeas nfp = do Just <$> (liftIO $ parseModuleEx flags' fp contents') setExtensions flags = do - hsc <- hscEnv <$> use_ GhcSession nfp - let dflags = hsc_dflags hsc - let hscExts = EnumSet.toList (extensionFlags dflags) - let hscExts' = mapMaybe (GhclibParserEx.readExtension . show) hscExts - let hlintExts = nub $ enabledExtensions flags ++ hscExts' + hlintExts <- getExtensions logm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts return $ flags { enabledExtensions = hlintExts } -#else - moduleEx _flags = do - mbpm <- getParsedModule nfp - return $ createModule <$> mbpm - where createModule pm = Right (createModuleEx anns modu) - where anns = pm_annotations pm - modu = pm_parsed_source pm + +getExtensions :: Action [Extension] +getExtensions = do + hsc <- hscEnv <$> use_ GhcSession nfp + let dflags = hsc_dflags hsc + let hscExts = EnumSet.toList (extensionFlags dflags) + let hscExts' = mapMaybe (GhclibParserEx.readExtension . show) hscExts + let hlintExts = nub $ enabledExtensions flags ++ hscExts' + return hlintExts #endif -- --------------------------------------------------------------------- @@ -334,10 +344,15 @@ applyOneCmd lf ide (AOP uri pos title) = do applyHint :: IdeState -> NormalizedFilePath -> Maybe OneHint -> IO (Either String WorkspaceEdit) applyHint ide nfp mhint = runExceptT $ do - ideas <- bimapExceptT showParseError id $ ExceptT $ liftIO $ runAction "applyHint" ide $ getIdeas nfp + let runAction' :: Action a -> IO a + runAction' = runAction "applyHint" ide + ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas nfp let ideas' = maybe ideas (`filterIdeas` ideas) mhint - let commands = map (show &&& ideaRefactoring) ideas' + let commands = map ideaRefactoring ideas' liftIO $ logm $ "applyHint:apply=" ++ show commands + let fp = fromNormalizedFilePath nfp + (_, mbOldContent) <- liftIO $ runAction' $ getFileContents nfp + oldContent <- maybe (liftIO $ T.readFile fp) return mbOldContent -- set Nothing as "position" for "applyRefactorings" because -- applyRefactorings expects the provided position to be _within_ the scope -- of each refactoring it will apply. @@ -353,19 +368,31 @@ applyHint ide nfp mhint = -- If we provide "applyRefactorings" with "Just (1,13)" then -- the "Redundant bracket" hint will never be executed -- because SrcSpan (1,20,??,??) doesn't contain position (1,13). - let fp = fromNormalizedFilePath nfp - (_, mbOldContent) <- liftIO $ runAction "hlint" ide $ getFileContents nfp - oldContent <- maybe (liftIO $ T.readFile fp) return mbOldContent - -- We need to save a file with last edited contents cause `apply-refact` - -- doesn't expose a function taking directly contents instead a file path. - -- Ideally we should try to expose that function upstream and remove this. - res <- liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do +#ifdef GHC_LIB + res <- + liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do hClose h writeFileUTF8NoNewLineTranslation temp oldContent - (Right <$> applyRefactorings Nothing commands temp) `catches` + let exts = runAction' getExtensions + (Right <$> applyRefactorings Nothing commands temp exts) + `catches` [ Handler $ \e -> return (Left (show (e :: IOException))) , Handler $ \e -> return (Left (show (e :: ErrorCall))) ] +#else + mbParsedModule <- liftIO $ runAction' $ getParsedModule nfp + res <- + case mbParsedModule of + Nothing -> throwE "Apply hint: error parsing the module" + Just pm -> do + let anns = pm_annotations pm + let modu = pm_parsed_source pm + hsc <- liftIO $ runAction' $ hscEnv <$> use_ GhcSession nfp + let dflags = hsc_dflags hsc + (anns', modu') <- + ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) normalLayout + liftIO (Right <$> applyRefactorings' Nothing commands anns' modu') +#endif case res of Right appliedFile -> do let uri = fromNormalizedUri (filePathToUri' nfp) @@ -373,7 +400,7 @@ applyHint ide nfp mhint = liftIO $ logm $ "hlint:applyHint:diff=" ++ show wsEdit ExceptT $ return (Right wsEdit) Left err -> - throwE (show err) + throwE err where -- | If we are only interested in applying a particular hint then -- let's filter out all the irrelevant ideas From 1416d625fb4c10e0959b9af410c5bde42a9b9d0d Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 21 Nov 2020 22:41:28 +0100 Subject: [PATCH 04/24] Inline utility function --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index b4392dd106..dae3cf5ad4 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -369,6 +369,11 @@ applyHint ide nfp mhint = -- the "Redundant bracket" hint will never be executed -- because SrcSpan (1,20,??,??) doesn't contain position (1,13). #ifdef GHC_LIB + let writeFileUTF8NoNewLineTranslation file txt = + withFile file WriteMode $ \h -> do + hSetEncoding h utf8 + hSetNewlineMode h noNewlineTranslation + hPutStr h (T.unpack txt) res <- liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do hClose h @@ -423,10 +428,3 @@ bimapExceptT f g (ExceptT m) = ExceptT (fmap h m) where h (Left e) = Left (f e) h (Right a) = Right (g a) {-# INLINE bimapExceptT #-} - -writeFileUTF8NoNewLineTranslation :: FilePath -> T.Text -> IO() -writeFileUTF8NoNewLineTranslation file txt = - withFile file WriteMode $ \h -> do - hSetEncoding h utf8 - hSetNewlineMode h noNewlineTranslation - hPutStr h (T.unpack txt) From aa2dd1ac7ebde890ddc00597261763dd0274bdeb Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 23 Nov 2020 22:04:57 +0100 Subject: [PATCH 05/24] Fix build for ghc < 8.10 --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index dae3cf5ad4..19fbdb94a9 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -40,7 +40,7 @@ import Development.IDE.Core.Shake (getDiagnostics) #ifdef GHC_LIB import Data.List (nub) import "ghc-lib" GHC hiding (DynFlags(..)) -import "ghc-lib" GHC.LanguageExtension (Extension) +import "ghc-lib-parser" GHC.LanguageExtensions (Extension) import "ghc" GHC as RealGHC (DynFlags(..)) import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags) import qualified "ghc" EnumSet as EnumSet @@ -370,10 +370,10 @@ applyHint ide nfp mhint = -- because SrcSpan (1,20,??,??) doesn't contain position (1,13). #ifdef GHC_LIB let writeFileUTF8NoNewLineTranslation file txt = - withFile file WriteMode $ \h -> do - hSetEncoding h utf8 - hSetNewlineMode h noNewlineTranslation - hPutStr h (T.unpack txt) + withFile file WriteMode $ \h -> do + hSetEncoding h utf8 + hSetNewlineMode h noNewlineTranslation + hPutStr h (T.unpack txt) res <- liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do hClose h From 7328e3b73b7679d9b65cb028115f47bf04a110ab Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 26 Nov 2020 22:15:53 +0100 Subject: [PATCH 06/24] Fix ghc-8.8 build --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 19fbdb94a9..b45ca7fea9 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -202,17 +202,17 @@ getIdeas nfp = do Just <$> (liftIO $ parseModuleEx flags' fp contents') setExtensions flags = do - hlintExts <- getExtensions + hlintExts <- getExtensions flags nfp logm $ "hlint:getIdeas:setExtensions:" ++ show hlintExts return $ flags { enabledExtensions = hlintExts } -getExtensions :: Action [Extension] -getExtensions = do +getExtensions :: ParseFlags -> NormalizedFilePath -> Action [Extension] +getExtensions pflags nfp = do hsc <- hscEnv <$> use_ GhcSession nfp let dflags = hsc_dflags hsc let hscExts = EnumSet.toList (extensionFlags dflags) let hscExts' = mapMaybe (GhclibParserEx.readExtension . show) hscExts - let hlintExts = nub $ enabledExtensions flags ++ hscExts' + let hlintExts = nub $ enabledExtensions pflags ++ hscExts' return hlintExts #endif @@ -378,9 +378,9 @@ applyHint ide nfp mhint = liftIO $ withSystemTempFile (takeFileName fp) $ \temp h -> do hClose h writeFileUTF8NoNewLineTranslation temp oldContent - let exts = runAction' getExtensions - (Right <$> applyRefactorings Nothing commands temp exts) - `catches` + (pflags, _, _) <- runAction' $ useNoFile_ GetHlintSettings + exts <- runAction' $ getExtensions pflags nfp + (Right <$> applyRefactorings Nothing commands temp (map show exts)) `catches` [ Handler $ \e -> return (Left (show (e :: IOException))) , Handler $ \e -> return (Left (show (e :: ErrorCall))) ] From cffaa4fc05b6be565bc0601dcdcbcc63f34a0bdf Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 27 Nov 2020 23:57:05 +0100 Subject: [PATCH 07/24] Reparse extensions to remove invalid ones --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index b45ca7fea9..20e72b280c 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -380,7 +380,10 @@ applyHint ide nfp mhint = writeFileUTF8NoNewLineTranslation temp oldContent (pflags, _, _) <- runAction' $ useNoFile_ GetHlintSettings exts <- runAction' $ getExtensions pflags nfp - (Right <$> applyRefactorings Nothing commands temp (map show exts)) `catches` + -- We have to reparse extensions to remove the invalid ones + let (enabled, disabled, _invalid) = parseExtensions $ map show exts + let refactExts = map show $ enabled ++ disabled + (Right <$> applyRefactorings Nothing commands temp refactExts) `catches` [ Handler $ \e -> return (Left (show (e :: IOException))) , Handler $ \e -> return (Left (show (e :: ErrorCall))) ] From 899230d9435930bae623d50c7144b1533529bf21 Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 19 Dec 2020 12:39:35 +0100 Subject: [PATCH 08/24] Restore hlint test changing doc content --- test/functional/FunctionalCodeAction.hs | 30 +++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index f02b500cd1..15ce2ec35d 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -83,6 +83,36 @@ hlintTests = testGroup "hlint suggestions" [ contents <- skipManyTill anyMessage $ getDocumentEdit doc liftIO $ contents @?= "main = undefined\nfoo = id\n" + , testCase "changing configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do + let config = def { hlintOn = True } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let config' = def { hlintOn = False } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config')) + + diags' <- waitForDiagnosticsFrom doc + + liftIO $ noHlintDiagnostics diags' + + , testCase "changing document contents updates hlint diagnostics" $ runHlintSession "" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + testHlintDiagnostics doc + + let change = TextDocumentContentChangeEvent + (Just (Range (Position 1 8) (Position 1 12))) + Nothing "x" + changeDoc doc [change] + expectNoMoreDiagnostics 3 doc "hlint" + + let change' = TextDocumentContentChangeEvent + (Just (Range (Position 1 8) (Position 1 12))) + Nothing "id x" + changeDoc doc [change'] + testHlintDiagnostics doc + , knownBrokenForGhcVersions [GHC88, GHC86] "hlint doesn't take in account cpp flag as ghc -D argument" $ testCase "hlint diagnostics works with CPP via ghc -XCPP argument (#554)" $ runHlintSession "cpp" $ do doc <- openDoc "ApplyRefact3.hs" "haskell" From 6db91f38e57b8e158d0a9c87337e823d6a762b80 Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 19 Dec 2020 21:35:04 +0100 Subject: [PATCH 09/24] Remove knownBroken for ghc < 8.10 --- test/functional/FunctionalCodeAction.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 15ce2ec35d..76225d084b 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -127,8 +127,7 @@ hlintTests = testGroup "hlint suggestions" [ doc <- openDoc "ApplyRefact2.hs" "haskell" testHlintDiagnostics doc - , knownBrokenForGhcVersions [GHC88, GHC86] "apply-refact doesn't take in account the -X argument" $ - testCase "apply-refact works with LambdaCase via ghc -XLambdaCase argument (#590)" $ runHlintSession "lambdacase" $ do + , testCase "apply-refact works with LambdaCase via ghc -XLambdaCase argument (#590)" $ runHlintSession "lambdacase" $ do testRefactor "ApplyRefact1.hs" "Redundant bracket" expectedLambdaCase From d02380dbfd4b24a97154586abc48149e482e8b2b Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 19 Dec 2020 22:02:25 +0100 Subject: [PATCH 10/24] Rename GHC_LIB cpp option --- plugins/hls-hlint-plugin/hls-hlint-plugin.cabal | 2 +- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 50243d3aa5..711d52a07a 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -62,7 +62,7 @@ library , ghc-lib ^>= 8.10.2.20200916 , ghc-lib-parser-ex ^>= 8.10 - cpp-options: -DGHC_LIB + cpp-options: -DHLINT_ON_GHC_LIB ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 20e72b280c..246f2debdb 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -37,7 +37,7 @@ import Development.IDE import Development.IDE.Core.Rules (defineNoFile) import Development.IDE.Core.Shake (getDiagnostics) -#ifdef GHC_LIB +#ifdef HLINT_ON_GHC_LIB import Data.List (nub) import "ghc-lib" GHC hiding (DynFlags(..)) import "ghc-lib-parser" GHC.LanguageExtensions (Extension) @@ -181,7 +181,7 @@ getIdeas nfp = do fmap applyHints' (moduleEx flags) where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx)) -#ifndef GHC_LIB +#ifndef HLINT_ON_GHC_LIB moduleEx _flags = do mbpm <- getParsedModule nfp return $ createModule <$> mbpm @@ -368,7 +368,7 @@ applyHint ide nfp mhint = -- If we provide "applyRefactorings" with "Just (1,13)" then -- the "Redundant bracket" hint will never be executed -- because SrcSpan (1,20,??,??) doesn't contain position (1,13). -#ifdef GHC_LIB +#ifdef HLINT_ON_GHC_LIB let writeFileUTF8NoNewLineTranslation file txt = withFile file WriteMode $ \h -> do hSetEncoding h utf8 From 86d1efe74176734ceefd89f09d173d0bd68a3b57 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 22 Dec 2020 10:41:04 +0100 Subject: [PATCH 11/24] Extract dflags from ModSummary --- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 27 +++++++++++-------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 246f2debdb..e74a393dce 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -20,7 +20,6 @@ module Ide.Plugin.Hlint import Refact.Apply import Control.Arrow ((&&&)) import Control.DeepSeq -import Control.Exception import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class @@ -38,16 +37,19 @@ import Development.IDE.Core.Rules (defineNoFile) import Development.IDE.Core.Shake (getDiagnostics) #ifdef HLINT_ON_GHC_LIB +import Control.Exception import Data.List (nub) -import "ghc-lib" GHC hiding (DynFlags(..)) +import "ghc-lib" GHC hiding (DynFlags(..), ms_hspp_opts) import "ghc-lib-parser" GHC.LanguageExtensions (Extension) import "ghc" GHC as RealGHC (DynFlags(..)) -import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags) +import "ghc" HscTypes as RealGHC.HscTypes (hsc_dflags, ms_hspp_opts) import qualified "ghc" EnumSet as EnumSet import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension) +import System.FilePath (takeFileName) +import System.IO (hPutStr, noNewlineTranslation, hSetNewlineMode, utf8, hSetEncoding, IOMode(WriteMode), withFile, hClose) +import System.IO.Temp #else import Development.IDE.GHC.Compat hiding (DynFlags(..)) -import HscTypes (hsc_dflags) import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) import Language.Haskell.GHC.ExactPrint.Delta (normalLayout) #endif @@ -58,12 +60,12 @@ import Ide.Plugin.Config import Ide.PluginUtils import Language.Haskell.HLint as Hlint import Language.Haskell.LSP.Core + ( LspFuncs(withIndefiniteProgress), + ProgressCancellable(Cancellable) ) import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Lens as LSP -import System.FilePath (takeFileName) -import System.IO (hPutStr, noNewlineTranslation, hSetNewlineMode, utf8, hSetEncoding, IOMode(WriteMode), withFile, hClose) -import System.IO.Temp + import Text.Regex.TDFA.Text() import GHC.Generics (Generic) @@ -208,12 +210,15 @@ getIdeas nfp = do getExtensions :: ParseFlags -> NormalizedFilePath -> Action [Extension] getExtensions pflags nfp = do - hsc <- hscEnv <$> use_ GhcSession nfp - let dflags = hsc_dflags hsc + dflags <- getFlags let hscExts = EnumSet.toList (extensionFlags dflags) let hscExts' = mapMaybe (GhclibParserEx.readExtension . show) hscExts let hlintExts = nub $ enabledExtensions pflags ++ hscExts' return hlintExts + where getFlags :: Action DynFlags + getFlags = do + (modsum, _) <- use_ GetModSummary nfp + return $ ms_hspp_opts modsum #endif -- --------------------------------------------------------------------- @@ -395,8 +400,8 @@ applyHint ide nfp mhint = Just pm -> do let anns = pm_annotations pm let modu = pm_parsed_source pm - hsc <- liftIO $ runAction' $ hscEnv <$> use_ GhcSession nfp - let dflags = hsc_dflags hsc + (modsum, _) <- liftIO $ runAction' $ use_ GetModSummary nfp + let dflags = ms_hspp_opts modsum (anns', modu') <- ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) normalLayout liftIO (Right <$> applyRefactorings' Nothing commands anns' modu') From 0fecd884e06366e049ecd9fb40ccd916d0d5244b Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 22 Dec 2020 23:46:42 +0100 Subject: [PATCH 12/24] Catch errors in the 8.10 code path --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index e74a393dce..1d47f28249 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -20,6 +20,7 @@ module Ide.Plugin.Hlint import Refact.Apply import Control.Arrow ((&&&)) import Control.DeepSeq +import Control.Exception import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class @@ -37,7 +38,6 @@ import Development.IDE.Core.Rules (defineNoFile) import Development.IDE.Core.Shake (getDiagnostics) #ifdef HLINT_ON_GHC_LIB -import Control.Exception import Data.List (nub) import "ghc-lib" GHC hiding (DynFlags(..), ms_hspp_opts) import "ghc-lib-parser" GHC.LanguageExtensions (Extension) @@ -351,6 +351,9 @@ applyHint ide nfp mhint = runExceptT $ do let runAction' :: Action a -> IO a runAction' = runAction "applyHint" ide + let errorHandlers = [ Handler $ \e -> return (Left (show (e :: IOException))) + , Handler $ \e -> return (Left (show (e :: ErrorCall))) + ] ideas <- bimapExceptT showParseError id $ ExceptT $ runAction' $ getIdeas nfp let ideas' = maybe ideas (`filterIdeas` ideas) mhint let commands = map ideaRefactoring ideas' @@ -388,10 +391,8 @@ applyHint ide nfp mhint = -- We have to reparse extensions to remove the invalid ones let (enabled, disabled, _invalid) = parseExtensions $ map show exts let refactExts = map show $ enabled ++ disabled - (Right <$> applyRefactorings Nothing commands temp refactExts) `catches` - [ Handler $ \e -> return (Left (show (e :: IOException))) - , Handler $ \e -> return (Left (show (e :: ErrorCall))) - ] + (Right <$> applyRefactorings Nothing commands temp refactExts) + `catches` errorHandlers #else mbParsedModule <- liftIO $ runAction' $ getParsedModule nfp res <- @@ -404,7 +405,8 @@ applyHint ide nfp mhint = let dflags = ms_hspp_opts modsum (anns', modu') <- ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) normalLayout - liftIO (Right <$> applyRefactorings' Nothing commands anns' modu') + liftIO $ (Right <$> applyRefactorings' Nothing commands anns' modu') + `catches` errorHandlers #endif case res of Right appliedFile -> do From 1dace14575d957cdd6c746f21ca7afd1e05218b6 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 23 Dec 2020 08:33:24 +0100 Subject: [PATCH 13/24] Test apply-refact preserve comments --- test/functional/FunctionalCodeAction.hs | 11 +++++++++++ test/testdata/hlint/ApplyRefact6.hs | 11 +++++++++++ test/testdata/hlint/hie.yaml | 1 + 3 files changed, 23 insertions(+) create mode 100644 test/testdata/hlint/ApplyRefact6.hs diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 76225d084b..92903da4bf 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -157,6 +157,9 @@ hlintTests = testGroup "hlint suggestions" [ testCase "hlint diagnostics ignore hints honouring HLINT annotations" $ runHlintSession "" $ do doc <- openDoc "ApplyRefact5.hs" "haskell" expectNoMoreDiagnostics 3 doc "hlint" + + , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do + testRefactor "ApplyRefact6.hs" "Redundant bracket" expectedComments ] where runHlintSession :: FilePath -> Session a -> IO a @@ -191,6 +194,14 @@ hlintTests = testGroup "hlint suggestions" [ , "g = 2" , "#endif", "" ] + expectedComments = [ "-- comment before header" + , "module ApplyRefact6 where", "" + , "{-# standalone annotation #-}", "" + , "-- standalone comment", "" + , "-- | haddock comment" + , "f = {- inline comment -} 1 -- ending comment", "" + , "-- final comment" + ] renameTests :: TestTree renameTests = testGroup "rename suggestions" [ diff --git a/test/testdata/hlint/ApplyRefact6.hs b/test/testdata/hlint/ApplyRefact6.hs new file mode 100644 index 0000000000..c0d0d379ba --- /dev/null +++ b/test/testdata/hlint/ApplyRefact6.hs @@ -0,0 +1,11 @@ +-- comment before header +module ApplyRefact6 where + +{-# standalone annotation #-} + +-- standalone comment + +-- | haddock comment +f = {- inline comment -} (1) -- ending comment + +-- final comment diff --git a/test/testdata/hlint/hie.yaml b/test/testdata/hlint/hie.yaml index 08c71a6ee2..98942ebb69 100644 --- a/test/testdata/hlint/hie.yaml +++ b/test/testdata/hlint/hie.yaml @@ -8,3 +8,4 @@ cradle: - "ApplyRefact3" - "ApplyRefact4" - "ApplyRefact5" + - "ApplyRefact6" From f6c5d777879c7c5d8102496fa9d75b17f86c789a Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 23 Dec 2020 21:06:36 +0100 Subject: [PATCH 14/24] Use rigidLayout (like apply-refact itself) --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 1d47f28249..8ca9f6ee03 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -51,7 +51,8 @@ import System.IO.Temp #else import Development.IDE.GHC.Compat hiding (DynFlags(..)) import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) -import Language.Haskell.GHC.ExactPrint.Delta (normalLayout) +import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions) +import Language.Haskell.GHC.ExactPrint.Types (Rigidity(..)) #endif import Ide.Logger @@ -403,8 +404,9 @@ applyHint ide nfp mhint = let modu = pm_parsed_source pm (modsum, _) <- liftIO $ runAction' $ use_ GetModSummary nfp let dflags = ms_hspp_opts modsum + let rigidLayout = deltaOptions RigidLayout (anns', modu') <- - ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) normalLayout + ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) rigidLayout liftIO $ (Right <$> applyRefactorings' Nothing commands anns' modu') `catches` errorHandlers #endif From 940f4143ea562344615e4fb19d8ed1c0820f1bde Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Dec 2020 21:13:10 +0100 Subject: [PATCH 15/24] Create shake getParsedModuleWithCommentsRule --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 10 ++++++++ ghcide/src/Development/IDE/Core/Rules.hs | 25 +++++++++++++++++--- 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 39f61b5fed..93c37f65a4 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -54,6 +54,10 @@ data LinkableType = ObjectLinkable | BCOLinkable -- | The parse tree for the file using GetFileContents type instance RuleResult GetParsedModule = ParsedModule +-- | The parse tree for the file using GetFileContents, +-- all comments included using Opt_KeepRawTokenStream +type instance RuleResult GetParsedModuleWithComments = ParsedModule + -- | The dependency information produced by following the imports recursively. -- This rule will succeed even if there is an error, e.g., a module could not be located, -- a module could not be parsed or an import cycle. @@ -302,6 +306,12 @@ instance Hashable GetParsedModule instance NFData GetParsedModule instance Binary GetParsedModule +data GetParsedModuleWithComments = GetParsedModuleWithComments + deriving (Eq, Show, Typeable, Generic) +instance Hashable GetParsedModuleWithComments +instance NFData GetParsedModuleWithComments +instance Binary GetParsedModuleWithComments + data GetLocatedImports = GetLocatedImports deriving (Eq, Show, Typeable, Generic) instance Hashable GetLocatedImports diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 862379894f..fed7dc806c 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -28,6 +28,7 @@ module Development.IDE.Core.Rules( getDependencies, getParsedModule, getClientConfigAction, + getParsedModuleWithComments ) where import Fingerprint @@ -242,9 +243,14 @@ getPackageHieFile ide mod file = do _ -> MaybeT $ return Nothing _ -> MaybeT $ return Nothing --- | Parse the contents of a daml file. +-- | Parse the contents of a haskell file. getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule) -getParsedModule file = use GetParsedModule file +getParsedModule = use GetParsedModule + +-- | Parse the contents of a haskell file, +-- ensuring comments are preserved in annotations +getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule) +getParsedModuleWithComments = use GetParsedModule ------------------------------------------------------------ -- Rules @@ -307,8 +313,10 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do pure res withOptHaddock :: ModSummary -> ModSummary -withOptHaddock ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) Opt_Haddock} +withOptHaddock = withOption Opt_Haddock +withOption :: GeneralFlag -> ModSummary -> ModSummary +withOption opt ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt} -- | Given some normal parse errors (first) and some from Haddock (second), merge them. -- Ignore Haddock errors that are in both. Demote Haddock-only errors to warnings. @@ -322,6 +330,16 @@ mergeParseErrorsHaddock normal haddock = normal ++ fixMessage x | "parse error " `T.isPrefixOf` x = "Haddock " <> x | otherwise = "Haddock: " <> x +getParsedModuleWithCommentsRule :: Rules () +getParsedModuleWithCommentsRule = defineEarlyCutoff $ \GetParsedModuleWithComments file -> do + (ms, _) <- use_ GetModSummary file + sess <- use_ GhcSession file + opt <- getIdeOptions + + let ms' = withOption Opt_KeepRawTokenStream ms + + liftIO $ getParsedModuleDefinition (hscEnv sess) opt file ms' + getParsedModuleDefinition :: HscEnv -> IdeOptions -> NormalizedFilePath -> ModSummary -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule)) getParsedModuleDefinition packageState opt file ms = do let fp = fromNormalizedFilePath file @@ -948,6 +966,7 @@ mainRule = do linkables <- liftIO $ newVar emptyModuleEnv addIdeGlobal $ CompiledLinkables linkables getParsedModuleRule + getParsedModuleWithCommentsRule getLocatedImportsRule getDependencyInformationRule reportImportCyclesRule From ceeeabcd3df5364bd6fb118d9d47e66f2725958c Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 29 Dec 2020 21:38:08 +0100 Subject: [PATCH 16/24] Use ghcide with getParsedModuleWithComments in hlint --- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 8ca9f6ee03..3e63501980 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -34,7 +34,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Typeable import Development.IDE -import Development.IDE.Core.Rules (defineNoFile) +import Development.IDE.Core.Rules (getParsedModuleWithComments, defineNoFile) import Development.IDE.Core.Shake (getDiagnostics) #ifdef HLINT_ON_GHC_LIB @@ -395,7 +395,7 @@ applyHint ide nfp mhint = (Right <$> applyRefactorings Nothing commands temp refactExts) `catches` errorHandlers #else - mbParsedModule <- liftIO $ runAction' $ getParsedModule nfp + mbParsedModule <- liftIO $ runAction' $ getParsedModuleWithComments nfp res <- case mbParsedModule of Nothing -> throwE "Apply hint: error parsing the module" @@ -404,6 +404,7 @@ applyHint ide nfp mhint = let modu = pm_parsed_source pm (modsum, _) <- liftIO $ runAction' $ use_ GetModSummary nfp let dflags = ms_hspp_opts modsum + -- apply-refact uses RigidLayout let rigidLayout = deltaOptions RigidLayout (anns', modu') <- ExceptT $ return $ postParseTransform (Right (anns, [], dflags, modu)) rigidLayout From 8a7f68cfadd12d392cb03c8dd8ddf88fa67ffd42 Mon Sep 17 00:00:00 2001 From: jneira Date: Sat, 9 Jan 2021 00:16:14 +0100 Subject: [PATCH 17/24] Restore utility function --- test/functional/FunctionalCodeAction.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 92903da4bf..0ce37bdd62 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -166,6 +166,10 @@ hlintTests = testGroup "hlint suggestions" [ runHlintSession subdir = failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata/hlint" subdir) + noHlintDiagnostics :: [Diagnostic] -> Assertion + noHlintDiagnostics diags = + Just "hlint" `notElem` map (^. L.source) diags @? "There are no hlint diagnostics" + testHlintDiagnostics doc = do diags <- waitForDiagnosticsFromSource doc "hlint" liftIO $ length diags > 0 @? "There are hlint diagnostics" From f17448ee5ef7bfceb2ccf7446b3031ccd5962547 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 12 Jan 2021 08:16:15 +0100 Subject: [PATCH 18/24] Fix getParsedModuleWithComments and add comments --- ghcide/src/Development/IDE/Core/Rules.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index fed7dc806c..6ec341675d 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -250,7 +250,7 @@ getParsedModule = use GetParsedModule -- | Parse the contents of a haskell file, -- ensuring comments are preserved in annotations getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule) -getParsedModuleWithComments = use GetParsedModule +getParsedModuleWithComments = use GetParsedModuleWithComments ------------------------------------------------------------ -- Rules @@ -265,12 +265,15 @@ priorityGenerateCore = Priority (-1) priorityFilesOfInterest :: Priority priorityFilesOfInterest = Priority (-2) --- | IMPORTANT FOR HLINT INTEGRATION: +-- | WARNING: -- We currently parse the module both with and without Opt_Haddock, and -- return the one with Haddocks if it -- succeeds. However, this may not work --- for hlint, and we might need to save the one without haddocks too. +-- for hlint or any client code that might need the parsed source with all +-- annotations, including comments. +-- For that use case you might want to use `getParsedModuleWithCommentsRule` -- See https://github.com/haskell/ghcide/pull/350#discussion_r370878197 -- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490 +-- GHC wiki about: https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations getParsedModuleRule :: Rules () getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do (ms, _) <- use_ GetModSummary file @@ -330,6 +333,9 @@ mergeParseErrorsHaddock normal haddock = normal ++ fixMessage x | "parse error " `T.isPrefixOf` x = "Haddock " <> x | otherwise = "Haddock: " <> x +-- | This rule provides a ParsedModule preserving all annotations, +-- including keywords, punctuation and comments. +-- So it is suitable for use cases where you need a perfect edit. getParsedModuleWithCommentsRule :: Rules () getParsedModuleWithCommentsRule = defineEarlyCutoff $ \GetParsedModuleWithComments file -> do (ms, _) <- use_ GetModSummary file From df20702c92772f8ebc2ff1ff2d70050239bc3a98 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Jan 2021 07:50:44 +0100 Subject: [PATCH 19/24] Used apply-refact HEAD --- cabal.project | 2 +- stack-8.10.1.yaml | 2 ++ stack-8.10.2.yaml | 2 ++ stack-8.10.3.yaml | 2 ++ stack-8.6.4.yaml | 4 +++- stack-8.6.5.yaml | 4 +++- stack-8.8.2.yaml | 4 +++- stack-8.8.3.yaml | 4 +++- stack-8.8.4.yaml | 4 +++- stack.yaml | 6 +++++- 10 files changed, 27 insertions(+), 7 deletions(-) diff --git a/cabal.project b/cabal.project index 2b90ddaf47..93a249df00 100644 --- a/cabal.project +++ b/cabal.project @@ -17,7 +17,7 @@ packages: source-repository-package type: git location: https://github.com/mpickering/apply-refact.git - tag: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d + tag: 58760460d31e89df82edf1d9048d95e707a39b69 tests: true diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index f4cb816898..cad4a8fc4b 100644 --- a/stack-8.10.1.yaml +++ b/stack-8.10.1.yaml @@ -20,6 +20,8 @@ ghc-options: "$everything": -haddock extra-deps: + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index 934ff35708..7921ccdc99 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -20,6 +20,8 @@ ghc-options: "$everything": -haddock extra-deps: + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index be40edcd2d..a2b13f9d3b 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -20,6 +20,8 @@ ghc-options: "$everything": -haddock extra-deps: + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 1ff6aa4916..6f16deb462 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -22,7 +22,9 @@ ghc-options: extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index a0b91a4c5e..d77aec9f18 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -21,7 +21,9 @@ ghc-options: extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index 44378ed62f..db1edd7901 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -21,7 +21,9 @@ ghc-options: extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - butcher-1.3.3.2 - bytestring-trie-0.2.5.0 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index baef50a947..86d8b94eb2 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -21,7 +21,9 @@ ghc-options: extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - bytestring-trie-0.2.5.0 - cabal-plan-0.6.2.0 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index c47abc2640..1d39a7638e 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -21,7 +21,9 @@ ghc-options: extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - brittany-0.13.1.0 - bytestring-trie-0.2.5.0 - cabal-plan-0.6.2.0 diff --git a/stack.yaml b/stack.yaml index a0b91a4c5e..5929928614 100644 --- a/stack.yaml +++ b/stack.yaml @@ -19,9 +19,13 @@ packages: ghc-options: "$everything": -haddock + + extra-deps: - aeson-1.5.2.0 - - apply-refact-0.8.2.1 + # - apply-refact-0.8.2.1 + - git: https://github.com/mpickering/apply-refact.git + commit: 58760460d31e89df82edf1d9048d95e707a39b69 - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 From 714443080a8f1526e96b670491a622a4594b107b Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Jan 2021 09:58:58 +0100 Subject: [PATCH 20/24] Use again apply-refact 4fbd3a --- cabal.project | 2 +- stack-8.10.1.yaml | 2 +- stack-8.10.2.yaml | 2 +- stack-8.10.3.yaml | 2 +- stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.2.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack.yaml | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/cabal.project b/cabal.project index 93a249df00..2b90ddaf47 100644 --- a/cabal.project +++ b/cabal.project @@ -17,7 +17,7 @@ packages: source-repository-package type: git location: https://github.com/mpickering/apply-refact.git - tag: 58760460d31e89df82edf1d9048d95e707a39b69 + tag: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d tests: true diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index cad4a8fc4b..50bfa9a6da 100644 --- a/stack-8.10.1.yaml +++ b/stack-8.10.1.yaml @@ -21,7 +21,7 @@ ghc-options: extra-deps: - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index 7921ccdc99..a15bdaeb74 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -21,7 +21,7 @@ ghc-options: extra-deps: - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index a2b13f9d3b..92d9409c9b 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -21,7 +21,7 @@ ghc-options: extra-deps: - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - Cabal-3.0.2.0 - clock-0.7.2 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 6f16deb462..a7b6ce1c28 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -24,7 +24,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index d77aec9f18..62f09cd8fd 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -23,7 +23,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index db1edd7901..cce7a99089 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -23,7 +23,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - butcher-1.3.3.2 - bytestring-trie-0.2.5.0 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 86d8b94eb2..e87d9d9841 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -23,7 +23,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - bytestring-trie-0.2.5.0 - cabal-plan-0.6.2.0 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 1d39a7638e..327e769ec2 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -23,7 +23,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - brittany-0.13.1.0 - bytestring-trie-0.2.5.0 - cabal-plan-0.6.2.0 diff --git a/stack.yaml b/stack.yaml index 5929928614..8c9ade2ec8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -25,7 +25,7 @@ extra-deps: - aeson-1.5.2.0 # - apply-refact-0.8.2.1 - git: https://github.com/mpickering/apply-refact.git - commit: 58760460d31e89df82edf1d9048d95e707a39b69 + commit: 4fbd3a3a9b408bd31080848feb6b78e13c3eeb6d - ansi-terminal-0.10.3 - base-compat-0.10.5 - brittany-0.13.1.0 From 88852f0b8d0b4d8551cfe944cfed0a9405e7c01b Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Jan 2021 10:15:34 +0100 Subject: [PATCH 21/24] Use ghc-exactprint-0.6.3.3 --- stack-8.10.1.yaml | 1 + stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.2.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack.yaml | 2 +- 7 files changed, 7 insertions(+), 6 deletions(-) diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index 50bfa9a6da..bbb951652b 100644 --- a/stack-8.10.1.yaml +++ b/stack-8.10.1.yaml @@ -28,6 +28,7 @@ extra-deps: - data-tree-print-0.1.0.2@rev:2 - floskell-0.10.4 - fourmolu-0.3.0.0 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - heapsize-0.3.0 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index a7b6ce1c28..4498447fb2 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -40,7 +40,7 @@ extra-deps: # - ghcide-0.1.0 - ghc-check-0.5.0.1 - ghc-events-0.13.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-lib-parser-ex-8.10.0.17 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 62f09cd8fd..e8ed5296ee 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -39,7 +39,7 @@ extra-deps: # - ghcide-0.1.0 - ghc-check-0.5.0.1 - ghc-events-0.13.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-lib-parser-ex-8.10.0.17 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index cce7a99089..16d9c0ed53 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -35,7 +35,7 @@ extra-deps: # - ghcide-0.6.0 - ghc-check-0.5.0.1 - ghc-events-0.13.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-lib-parser-ex-8.10.0.17 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index e87d9d9841..9f20b9e418 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -33,7 +33,7 @@ extra-deps: - floskell-0.10.4 - fourmolu-0.3.0.0 # - ghcide-0.6.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-trace-events-0.1.2.1 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 327e769ec2..47b9d5d736 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -32,7 +32,7 @@ extra-deps: - floskell-0.10.4 - fourmolu-0.3.0.0 # - ghcide-0.6.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-trace-events-0.1.2.1 diff --git a/stack.yaml b/stack.yaml index 8c9ade2ec8..7c3206d711 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,7 +41,7 @@ extra-deps: # - ghcide-0.1.0 - ghc-check-0.5.0.1 - ghc-events-0.13.0 - - ghc-exactprint-0.6.3.2 + - ghc-exactprint-0.6.3.3 - ghc-lib-8.10.3.20201220 - ghc-lib-parser-8.10.3.20201220 - ghc-lib-parser-ex-8.10.0.17 From decf082cc25e0c53d913a420c0e6e805c7799ca4 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Jan 2021 20:54:47 +0100 Subject: [PATCH 22/24] Test comment inside refactoring --- test/functional/FunctionalCodeAction.hs | 2 +- test/testdata/hlint/ApplyRefact6.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 0ce37bdd62..4148ccc0f2 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -203,7 +203,7 @@ hlintTests = testGroup "hlint suggestions" [ , "{-# standalone annotation #-}", "" , "-- standalone comment", "" , "-- | haddock comment" - , "f = {- inline comment -} 1 -- ending comment", "" + , "f = {- inline comment -}{- inline comment inside refactored code -} 1 -- ending comment", "" , "-- final comment" ] diff --git a/test/testdata/hlint/ApplyRefact6.hs b/test/testdata/hlint/ApplyRefact6.hs index c0d0d379ba..8c5debea21 100644 --- a/test/testdata/hlint/ApplyRefact6.hs +++ b/test/testdata/hlint/ApplyRefact6.hs @@ -6,6 +6,6 @@ module ApplyRefact6 where -- standalone comment -- | haddock comment -f = {- inline comment -} (1) -- ending comment +f = {- inline comment -} ({- inline comment inside refactored code -}1) -- ending comment -- final comment From c16f516f23c5044208038a582f9f38b8879f1210 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Jan 2021 14:05:58 +0100 Subject: [PATCH 23/24] Update hackage index to invalidate gha cache --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index f0b2f3e23b..dc4ad52982 100644 --- a/cabal.project +++ b/cabal.project @@ -30,7 +30,7 @@ package ghcide write-ghc-environment-files: never -index-state: 2021-01-07T18:06:52Z +index-state: 2021-01-14T12:49:26Z allow-newer: active:base, From a0b3e4d946ce66669b297934a3faa5379103160c Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Jan 2021 14:22:48 +0100 Subject: [PATCH 24/24] Invalidate cache using versioning --- .github/workflows/bench.yml | 8 ++++---- .github/workflows/test.yml | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 51f28525ab..4976092c45 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -26,11 +26,11 @@ jobs: path: | ~/.cabal/packages ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-bench-${{ hashFiles('cabal.project') }} + key: v2-${{ runner.os }}-${{ matrix.ghc }}-bench-${{ hashFiles('cabal.project') }} restore-keys: | - ${{ runner.os }}-${{ matrix.ghc }}-build-${{ hashFiles('cabal.project') }} - ${{ runner.os }}-${{ matrix.ghc }}-bench- - ${{ runner.os }}-${{ matrix.ghc }} + v2-${{ runner.os }}-${{ matrix.ghc }}-build-${{ hashFiles('cabal.project') }} + v2-${{ runner.os }}-${{ matrix.ghc }}-bench- + v2-${{ runner.os }}-${{ matrix.ghc }} - run: cabal update diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 2fbc3111e2..f79587045e 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -79,11 +79,11 @@ jobs: path: | ${{ env.CABAL_PKGS_DIR }} ${{ env.CABAL_STORE_DIR }} - key: ${{ runner.os }}-${{ matrix.ghc }}-build-${{ hashFiles('cabal.project') }} + key: v2-${{ runner.os }}-${{ matrix.ghc }}-build-${{ hashFiles('cabal.project') }} restore-keys: | - ${{ runner.os }}-${{ matrix.ghc }}-bench-${{ hashFiles('cabal.project') }} - ${{ runner.os }}-${{ matrix.ghc }}-build- - ${{ runner.os }}-${{ matrix.ghc }} + v2-${{ runner.os }}-${{ matrix.ghc }}-bench-${{ hashFiles('cabal.project') }} + v2-${{ runner.os }}-${{ matrix.ghc }}-build- + v2-${{ runner.os }}-${{ matrix.ghc }} - run: cabal update