From 90de2b3d678304572fbe46dda2531db96f411825 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sat, 12 Dec 2020 16:58:55 +0800 Subject: [PATCH 1/3] Do not suggest explicitly disabled pragmas --- plugins/default/src/Ide/Plugin/Pragmas.hs | 64 ++++++++++++++--------- 1 file changed, 38 insertions(+), 26 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index 6ad3a93f05..f8df1cfc1d 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} -- | Provides code actions to add missing pragmas (whenever GHC suggests to) module Ide.Plugin.Pragmas @@ -10,20 +10,22 @@ module Ide.Plugin.Pragmas -- , commands -- TODO: get rid of this ) where -import Control.Lens hiding (List) +import Control.Lens hiding (List) import Data.Aeson import qualified Data.HashMap.Strict as H import qualified Data.Text as T +import Development.IDE as D +import qualified GHC.Generics as Generics import Ide.Plugin import Ide.Types -import qualified GHC.Generics as Generics +import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types as J import qualified Language.Haskell.LSP.Types.Lens as J -import Development.IDE as D -import Language.Haskell.LSP.Types -import qualified Language.Haskell.LSP.Core as LSP -import qualified Language.Haskell.LSP.VFS as VFS +import Control.Monad (join) +import Development.IDE.GHC.Compat +import qualified Language.Haskell.LSP.Core as LSP +import qualified Language.Haskell.LSP.VFS as VFS -- --------------------------------------------------------------------- @@ -67,28 +69,38 @@ addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res)) -- --------------------------------------------------------------------- - +-- ms_hspp_opts -- | Offer to add a missing Language Pragma to the top of a file. -- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'. codeActionProvider :: CodeActionProvider -codeActionProvider _ _ plId docId _ (J.CodeActionContext (J.List diags) _monly) = do - cmds <- mapM mkCommand pragmas - -- cmds <- mapM mkCommand ("FooPragma":pragmas) - return $ Right $ List cmds - where +codeActionProvider _ state plId docId _ (J.CodeActionContext (J.List diags) _monly) = do + let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath' + pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile + let dflags = ms_hspp_opts . pm_mod_summary <$> pm -- Filter diagnostics that are from ghcmod - ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags + ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags -- Get all potential Pragmas for all diagnostics. - pragmas = concatMap (\d -> findPragma (d ^. J.message)) ghcDiags - mkCommand pragmaName = do - let - -- | Code Action for the given command. - codeAction :: J.Command -> J.CAResult - codeAction cmd = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd) - title = "Add \"" <> pragmaName <> "\"" - cmdParams = [toJSON (AddPragmaParams (docId ^. J.uri) pragmaName )] - cmd <- mkLspCommand plId "addPragma" title (Just cmdParams) - return $ codeAction cmd + pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) ghcDiags + -- cmds <- mapM mkCommand ("FooPragma":pragmas) + cmds <- mapM mkCommand pragmas + return $ Right $ List cmds + where + mkCommand pragmaName = do + let + -- | Code Action for the given command. + codeAction :: J.Command -> J.CAResult + codeAction cmd = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd) + title = "Add \"" <> pragmaName <> "\"" + cmdParams = [toJSON (AddPragmaParams (docId ^. J.uri) pragmaName)] + cmd <- mkLspCommand plId "addPragma" title (Just cmdParams) + return $ codeAction cmd + genPragma mDynflags target + | Just dynFlags <- mDynflags, + -- GHC does not export 'OnOff', so we have to convert it into string + disabled <- [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags] + = [ r | r <- findPragma target, r `notElem` disabled] + | otherwise = [] + -- --------------------------------------------------------------------- From 0405631b1a89b581a0955e5c3ac4d21005120143 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sat, 12 Dec 2020 17:15:53 +0800 Subject: [PATCH 2/3] Use xFlags, instead of enumerating possible language extensions --- plugins/default/src/Ide/Plugin/Pragmas.hs | 64 ++--------------------- 1 file changed, 3 insertions(+), 61 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index f8df1cfc1d..d8ff43b994 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -113,68 +114,9 @@ findPragma str = concatMap check possiblePragmas -- --------------------------------------------------------------------- -- | Possible Pragma names. --- Is non-exhaustive, and may be extended. +-- See discussion at https://github.com/digital-asset/ghcide/pull/638 possiblePragmas :: [T.Text] -possiblePragmas = - [ - "ConstraintKinds" - , "DefaultSignatures" - , "DeriveAnyClass" - , "DeriveDataTypeable" - , "DeriveFoldable" - , "DeriveFunctor" - , "DeriveGeneric" - , "DeriveLift" - , "DeriveTraversable" - , "DerivingStrategies" - , "DerivingVia" - , "EmptyCase" - , "EmptyDataDecls" - , "EmptyDataDeriving" - , "FlexibleContexts" - , "FlexibleInstances" - , "GADTs" - , "GHCForeignImportPrim" - , "GeneralizedNewtypeDeriving" - , "IncoherentInstances" - , "InstanceSigs" - , "KindSignatures" - , "MultiParamTypeClasses" - , "MultiWayIf" - , "NamedFieldPuns" - , "NamedWildCards" - , "OverloadedStrings" - , "ParallelListComp" - , "PartialTypeSignatures" - , "PatternGuards" - , "PatternSignatures" - , "PatternSynonyms" - , "QuasiQuotes" - , "Rank2Types" - , "RankNTypes" - , "RecordPuns" - , "RecordWildCards" - , "RecursiveDo" - , "RelaxedPolyRec" - , "RoleAnnotations" - , "ScopedTypeVariables" - , "StandaloneDeriving" - , "StaticPointers" - , "TemplateHaskell" - , "TemplateHaskellQuotes" - , "TransformListComp" - , "TupleSections" - , "TypeApplications" - , "TypeFamilies" - , "TypeFamilyDependencies" - , "TypeInType" - , "TypeOperators" - , "TypeSynonymInstances" - , "UnboxedSums" - , "UndecidableInstances" - , "UndecidableSuperClasses" - , "ViewPatterns" - ] +possiblePragmas = [name | FlagSpec{flagSpecName = T.pack -> name} <- xFlags, "Strict" /= name] -- --------------------------------------------------------------------- From 313916ae712999c15cdeeb67bdf6259afae82820 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sat, 12 Dec 2020 17:19:53 +0800 Subject: [PATCH 3/3] Update comments --- plugins/default/src/Ide/Plugin/Pragmas.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index d8ff43b994..d043a06aae 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -70,7 +70,6 @@ addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res)) -- --------------------------------------------------------------------- --- ms_hspp_opts -- | Offer to add a missing Language Pragma to the top of a file. -- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'. codeActionProvider :: CodeActionProvider @@ -97,7 +96,7 @@ codeActionProvider _ state plId docId _ (J.CodeActionContext (J.List diags) _mon return $ codeAction cmd genPragma mDynflags target | Just dynFlags <- mDynflags, - -- GHC does not export 'OnOff', so we have to convert it into string + -- GHC does not export 'OnOff', so we have to view it as string disabled <- [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags] = [ r | r <- findPragma target, r `notElem` disabled] | otherwise = [] @@ -114,7 +113,7 @@ findPragma str = concatMap check possiblePragmas -- --------------------------------------------------------------------- -- | Possible Pragma names. --- See discussion at https://github.com/digital-asset/ghcide/pull/638 +-- See discussion at https://github.com/haskell/ghcide/pull/638 possiblePragmas :: [T.Text] possiblePragmas = [name | FlagSpec{flagSpecName = T.pack -> name} <- xFlags, "Strict" /= name]