From cdc655b255173d5de671d804cc9d71bc843b242c Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 7 Mar 2021 14:26:24 -0800 Subject: [PATCH 1/5] Simplify module structure --- .../hls-tactics-plugin.cabal | 38 +++++++++---------- .../src/Ide/Plugin/Tactic.hs | 14 +++---- .../{Ide/Plugin/Tactic => Wingman}/Auto.hs | 16 ++++---- .../Plugin/Tactic => Wingman}/CaseSplit.hs | 16 ++++---- .../{Ide/Plugin/Tactic => Wingman}/CodeGen.hs | 18 ++++----- .../Tactic => Wingman}/CodeGen/Utils.hs | 4 +- .../{Ide/Plugin/Tactic => Wingman}/Context.hs | 20 +++++----- .../{Ide/Plugin/Tactic => Wingman}/Debug.hs | 2 +- .../Plugin/Tactic => Wingman}/FeatureSet.hs | 2 +- .../src/{Ide/Plugin/Tactic => Wingman}/GHC.hs | 6 +-- .../Plugin/Tactic => Wingman}/Judgements.hs | 4 +- .../Tactic => Wingman}/KnownStrategies.hs | 12 +++--- .../KnownStrategies/QuickCheck.hs | 10 ++--- .../Tactic => Wingman}/LanguageServer.hs | 14 +++---- .../LanguageServer/TacticProviders.hs | 14 +++---- .../Plugin/Tactic => Wingman}/Machinery.hs | 8 ++-- .../{Ide/Plugin/Tactic => Wingman}/Naming.hs | 16 ++++---- .../{Ide/Plugin/Tactic => Wingman}/Range.hs | 4 +- .../Plugin/Tactic => Wingman}/Simplify.hs | 19 +++++----- .../{Ide/Plugin/Tactic => Wingman}/Tactics.hs | 18 ++++----- .../{Ide/Plugin/Tactic => Wingman}/Types.hs | 14 +++---- .../hls-tactics-plugin/test/AutoTupleSpec.hs | 8 ++-- .../test/CodeAction/AutoSpec.hs | 4 +- .../test/CodeAction/DestructAllSpec.hs | 2 +- .../test/CodeAction/DestructSpec.hs | 2 +- .../test/CodeAction/IntrosSpec.hs | 2 +- .../test/CodeAction/RefineSpec.hs | 4 +- .../test/CodeAction/UseDataConSpec.hs | 2 +- .../hls-tactics-plugin/test/ProviderSpec.hs | 2 +- .../test/UnificationSpec.hs | 6 +-- plugins/hls-tactics-plugin/test/Utils.hs | 6 +-- 31 files changed, 153 insertions(+), 154 deletions(-) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Auto.hs (54%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/CaseSplit.hs (88%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/CodeGen.hs (94%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/CodeGen/Utils.hs (95%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Context.hs (82%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Debug.hs (98%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/FeatureSet.hs (98%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/GHC.hs (98%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Judgements.hs (99%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/KnownStrategies.hs (68%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/KnownStrategies/QuickCheck.hs (95%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/LanguageServer.hs (97%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/LanguageServer/TacticProviders.hs (97%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Machinery.hs (98%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Naming.hs (87%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Range.hs (87%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Simplify.hs (85%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Tactics.hs (96%) rename plugins/hls-tactics-plugin/src/{Ide/Plugin/Tactic => Wingman}/Types.hs (98%) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index a507a5e657..95fc785aac 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -25,25 +25,25 @@ library hs-source-dirs: src exposed-modules: Ide.Plugin.Tactic - Ide.Plugin.Tactic.Auto - Ide.Plugin.Tactic.CaseSplit - Ide.Plugin.Tactic.CodeGen - Ide.Plugin.Tactic.CodeGen.Utils - Ide.Plugin.Tactic.Context - Ide.Plugin.Tactic.Debug - Ide.Plugin.Tactic.FeatureSet - Ide.Plugin.Tactic.GHC - Ide.Plugin.Tactic.Judgements - Ide.Plugin.Tactic.KnownStrategies - Ide.Plugin.Tactic.KnownStrategies.QuickCheck - Ide.Plugin.Tactic.LanguageServer - Ide.Plugin.Tactic.LanguageServer.TacticProviders - Ide.Plugin.Tactic.Machinery - Ide.Plugin.Tactic.Naming - Ide.Plugin.Tactic.Range - Ide.Plugin.Tactic.Simplify - Ide.Plugin.Tactic.Tactics - Ide.Plugin.Tactic.Types + Wingman.Auto + Wingman.CaseSplit + Wingman.CodeGen + Wingman.CodeGen.Utils + Wingman.Context + Wingman.Debug + Wingman.FeatureSet + Wingman.GHC + Wingman.Judgements + Wingman.KnownStrategies + Wingman.KnownStrategies.QuickCheck + Wingman.LanguageServer + Wingman.LanguageServer.TacticProviders + Wingman.Machinery + Wingman.Naming + Wingman.Range + Wingman.Simplify + Wingman.Tactics + Wingman.Types ghc-options: -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index 5aae79cf97..793445f96c 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -31,13 +31,6 @@ import Data.Traversable import Development.IDE.Core.Shake (IdeState (..)) import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint -import Ide.Plugin.Tactic.CaseSplit -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.LanguageServer -import Ide.Plugin.Tactic.LanguageServer.TacticProviders -import Ide.Plugin.Tactic.Range -import Ide.Plugin.Tactic.Tactics -import Ide.Plugin.Tactic.Types import Ide.Types import Language.LSP.Server import Language.LSP.Types @@ -45,6 +38,13 @@ import Language.LSP.Types.Capabilities import OccName import Prelude hiding (span) import System.Timeout +import Wingman.CaseSplit +import Wingman.GHC +import Wingman.LanguageServer +import Wingman.LanguageServer.TacticProviders +import Wingman.Range +import Wingman.Tactics +import Wingman.Types descriptor :: PluginId -> PluginDescriptor IdeState diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs b/plugins/hls-tactics-plugin/src/Wingman/Auto.hs similarity index 54% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs rename to plugins/hls-tactics-plugin/src/Wingman/Auto.hs index 05bdb5c862..7c42ffd430 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Auto.hs @@ -1,13 +1,13 @@ -module Ide.Plugin.Tactic.Auto where +module Wingman.Auto where -import Control.Monad.State (gets) -import Ide.Plugin.Tactic.Context -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.KnownStrategies -import Ide.Plugin.Tactic.Machinery (tracing) -import Ide.Plugin.Tactic.Tactics -import Ide.Plugin.Tactic.Types +import Control.Monad.State (gets) import Refinery.Tactic +import Wingman.Context +import Wingman.Judgements +import Wingman.KnownStrategies +import Wingman.Machinery (tracing) +import Wingman.Tactics +import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs similarity index 88% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs rename to plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs index 79ce781d4d..231661cd0f 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs @@ -3,23 +3,23 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.CaseSplit +module Wingman.CaseSplit ( mkFirstAgda , iterateSplit , splitToDecl ) where -import Data.Bool (bool) +import Data.Bool (bool) import Data.Data import Data.Generics -import Data.Set (Set) -import qualified Data.Set as S +import Data.Set (Set) +import qualified Data.Set as S import Development.IDE.GHC.Compat -import GHC.Exts (IsString (fromString)) -import GHC.SourceGen (funBinds, match, wildP) -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.Types +import GHC.Exts (IsString (fromString)) +import GHC.SourceGen (funBinds, match, wildP) import OccName +import Wingman.GHC +import Wingman.Types diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs similarity index 94% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs rename to plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs index 750743dca1..3906fcc578 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs @@ -3,9 +3,9 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -module Ide.Plugin.Tactic.CodeGen - ( module Ide.Plugin.Tactic.CodeGen - , module Ide.Plugin.Tactic.CodeGen.Utils +module Wingman.CodeGen + ( module Wingman.CodeGen + , module Wingman.CodeGen.Utils ) where @@ -22,13 +22,13 @@ import GHC.SourceGen.Binds import GHC.SourceGen.Expr import GHC.SourceGen.Overloaded import GHC.SourceGen.Pat -import Ide.Plugin.Tactic.CodeGen.Utils -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Naming -import Ide.Plugin.Tactic.Types import Type hiding (Var) +import Wingman.CodeGen.Utils +import Wingman.GHC +import Wingman.Judgements +import Wingman.Machinery +import Wingman.Naming +import Wingman.Types destructMatches diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs similarity index 95% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs rename to plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs index eb728066bc..db8b837a41 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.CodeGen.Utils where +module Wingman.CodeGen.Utils where import Data.List import DataCon @@ -8,7 +8,7 @@ import Development.IDE.GHC.Compat import GHC.Exts import GHC.SourceGen (RdrNameStr, recordConE) import GHC.SourceGen.Overloaded -import Ide.Plugin.Tactic.GHC (getRecordFields) +import Wingman.GHC (getRecordFields) import Name diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs b/plugins/hls-tactics-plugin/src/Wingman/Context.hs similarity index 82% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs rename to plugins/hls-tactics-plugin/src/Wingman/Context.hs index f13421b4e1..8154a7c7b8 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Context.hs @@ -1,24 +1,24 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} -module Ide.Plugin.Tactic.Context where +module Wingman.Context where import Bag import Control.Arrow import Control.Monad.Reader import Data.List -import Data.Maybe (mapMaybe) -import Data.Set (Set) -import qualified Data.Set as S +import Data.Maybe (mapMaybe) +import Data.Set (Set) +import qualified Data.Set as S import Development.IDE.GHC.Compat -import Ide.Plugin.Tactic.FeatureSet (FeatureSet) -import Ide.Plugin.Tactic.GHC (tacticsThetaTy) -import Ide.Plugin.Tactic.Machinery (methodHypothesis) -import Ide.Plugin.Tactic.Types import OccName import TcRnTypes -import TcType (substTy, tcSplitSigmaTy) -import Unify (tcUnifyTy) +import TcType (substTy, tcSplitSigmaTy) +import Unify (tcUnifyTy) +import Wingman.FeatureSet (FeatureSet) +import Wingman.GHC (tacticsThetaTy) +import Wingman.Machinery (methodHypothesis) +import Wingman.Types mkContext :: FeatureSet -> [(OccName, CType)] -> TcGblEnv -> Context diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs similarity index 98% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs rename to plugins/hls-tactics-plugin/src/Wingman/Debug.hs index a66fe016d2..7db728b9ab 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} -module Ide.Plugin.Tactic.Debug +module Wingman.Debug ( unsafeRender , unsafeRender' , traceM diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs b/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs similarity index 98% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs rename to plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs index 426d7949bf..f6f8f47c3b 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/FeatureSet.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} -module Ide.Plugin.Tactic.FeatureSet +module Wingman.FeatureSet ( Feature (..) , FeatureSet , hasFeature diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs similarity index 98% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs rename to plugins/hls-tactics-plugin/src/Wingman/GHC.hs index c4d9de9728..11b350550f 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -7,11 +7,12 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.GHC where +module Wingman.GHC where import Control.Arrow import Control.Monad.State import Data.Function (on) +import Data.Functor ((<&>)) import Data.List (isPrefixOf) import qualified Data.Map as M import Data.Maybe (isJust) @@ -22,7 +23,6 @@ import DataCon import Development.IDE.GHC.Compat import GHC.SourceGen (case', lambda, match) import Generics.SYB (Data, everything, everywhere, listify, mkQ, mkT) -import Ide.Plugin.Tactic.Types import OccName import TcType import TyCoRep @@ -30,7 +30,7 @@ import Type import TysWiredIn (charTyCon, doubleTyCon, floatTyCon, intTyCon) import Unique import Var -import Data.Functor ((<&>)) +import Wingman.Types tcTyVar_maybe :: Type -> Maybe Var diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs similarity index 99% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs rename to plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 882cd4b5f8..cfba75e000 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.Judgements where +module Wingman.Judgements where import Control.Arrow import Control.Lens hiding (Context) @@ -16,10 +16,10 @@ import Data.Set (Set) import qualified Data.Set as S import DataCon (DataCon) import Development.IDE.Spans.LocalBindings -import Ide.Plugin.Tactic.Types import OccName import SrcLoc import Type +import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs similarity index 68% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs rename to plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs index d159dd03b5..ff631adeea 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs @@ -1,15 +1,15 @@ {-# LANGUAGE LambdaCase #-} -module Ide.Plugin.Tactic.KnownStrategies where +module Wingman.KnownStrategies where import Control.Monad.Error.Class -import Ide.Plugin.Tactic.Context (getCurrentDefinitions) -import Ide.Plugin.Tactic.KnownStrategies.QuickCheck (deriveArbitrary) -import Ide.Plugin.Tactic.Machinery (tracing) -import Ide.Plugin.Tactic.Tactics -import Ide.Plugin.Tactic.Types import OccName (mkVarOcc) import Refinery.Tactic +import Wingman.Context (getCurrentDefinitions) +import Wingman.KnownStrategies.QuickCheck (deriveArbitrary) +import Wingman.Machinery (tracing) +import Wingman.Tactics +import Wingman.Types knownStrategies :: TacticsM () diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs similarity index 95% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs rename to plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs index a61f86dbce..f3e53dafd3 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.KnownStrategies.QuickCheck where +module Wingman.KnownStrategies.QuickCheck where import Control.Monad.Except (MonadError (throwError)) import Data.Bool (bool) @@ -15,10 +15,10 @@ import GHC.SourceGen.Binds (match, valBind) import GHC.SourceGen.Expr (case', lambda, let') import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) import GHC.SourceGen.Pat (conP) -import Ide.Plugin.Tactic.CodeGen -import Ide.Plugin.Tactic.Judgements (jGoal) -import Ide.Plugin.Tactic.Machinery (tracePrim) -import Ide.Plugin.Tactic.Types +import Wingman.CodeGen +import Wingman.Judgements (jGoal) +import Wingman.Machinery (tracePrim) +import Wingman.Types import OccName (HasOccName (occName), mkVarOcc, occNameString) import Refinery.Tactic (goal, rule) diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs similarity index 97% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs rename to plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index 671d16bffd..fa284b3c67 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -7,7 +7,7 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wall #-} -module Ide.Plugin.Tactic.LanguageServer where +module Wingman.LanguageServer where import ConLike import Control.Arrow @@ -40,18 +40,18 @@ import qualified FastString import GhcPlugins (mkAppTys, tupleDataCon, consDataCon) import Ide.Plugin.Config (PluginConfig (plcConfig)) import qualified Ide.Plugin.Config as Plugin -import Ide.Plugin.Tactic.Context -import Ide.Plugin.Tactic.FeatureSet -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Range -import Ide.Plugin.Tactic.Types import Language.LSP.Server (MonadLsp, sendNotification) import Language.LSP.Types import OccName import Prelude hiding (span) import SrcLoc (containsSpan) import TcRnTypes (tcg_binds) +import Wingman.Context +import Wingman.FeatureSet +import Wingman.GHC +import Wingman.Judgements +import Wingman.Range +import Wingman.Types tacticDesc :: T.Text -> T.Text diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs similarity index 97% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs rename to plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs index 345d14c891..1fe79b143c 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wall #-} -module Ide.Plugin.Tactic.LanguageServer.TacticProviders +module Wingman.LanguageServer.TacticProviders ( commandProvider , commandTactic , tcCommandId @@ -26,12 +26,12 @@ import DataCon (dataConName) import Development.IDE.GHC.Compat import GHC.Generics import GHC.LanguageExtensions.Type (Extension (LambdaCase)) -import Ide.Plugin.Tactic.Auto -import Ide.Plugin.Tactic.FeatureSet -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Tactics -import Ide.Plugin.Tactic.Types +import Wingman.Auto +import Wingman.FeatureSet +import Wingman.GHC +import Wingman.Judgements +import Wingman.Tactics +import Wingman.Types import Ide.PluginUtils import Ide.Types import Language.LSP.Types diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs similarity index 98% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs rename to plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 30fc29cf42..1df770d233 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.Machinery where +module Wingman.Machinery where import Class (Class (classTyVars)) import Control.Lens ((<>~)) @@ -31,9 +31,6 @@ import Data.Ord (Down (..), comparing) import Data.Set (Set) import qualified Data.Set as S import Development.IDE.GHC.Compat -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Simplify (simplify) -import Ide.Plugin.Tactic.Types import OccName (HasOccName (occName)) import Refinery.ProofState import Refinery.Tactic @@ -41,6 +38,9 @@ import Refinery.Tactic.Internal import TcType import Type import Unify +import Wingman.Judgements +import Wingman.Simplify (simplify) +import Wingman.Types substCTy :: TCvSubst -> CType -> CType diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs similarity index 87% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs rename to plugins/hls-tactics-plugin/src/Wingman/Naming.hs index 03c91972a4..9216194490 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs @@ -1,21 +1,21 @@ {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.Naming where +module Wingman.Naming where import Control.Monad.State.Strict -import Data.Bool (bool) +import Data.Bool (bool) import Data.Char -import Data.Map (Map) -import qualified Data.Map as M -import Data.Set (Set) -import qualified Data.Set as S +import Data.Map (Map) +import qualified Data.Map as M +import Data.Set (Set) +import qualified Data.Set as S import Data.Traversable import Name import TcType import TyCon import Type -import TysWiredIn (listTyCon, pairTyCon, unitTyCon) -import Ide.Plugin.Tactic.Types +import TysWiredIn (listTyCon, pairTyCon, unitTyCon) +import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs b/plugins/hls-tactics-plugin/src/Wingman/Range.hs similarity index 87% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs rename to plugins/hls-tactics-plugin/src/Wingman/Range.hs index 3c8de54ee4..470e207742 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Range.hs @@ -1,7 +1,7 @@ -module Ide.Plugin.Tactic.Range where +module Wingman.Range where import Development.IDE.Types.Location -import qualified FastString as FS +import qualified FastString as FS import SrcLoc ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs similarity index 85% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs rename to plugins/hls-tactics-plugin/src/Wingman/Simplify.hs index b89f290756..3042229a17 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs @@ -4,19 +4,18 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Tactic.Simplify +module Wingman.Simplify ( simplify ) where -import Data.Generics (GenericT, everywhere, mkT) -import Data.List.Extra (unsnoc) -import Data.Monoid (Endo (..)) -import Development.IDE.GHC.Compat -import GHC.SourceGen (var) -import GHC.SourceGen.Expr (lambda) -import Ide.Plugin.Tactic.CodeGen.Utils -import Ide.Plugin.Tactic.GHC (containsHsVar, - fromPatCompatPs) +import Data.Generics (GenericT, everywhere, mkT) +import Data.List.Extra (unsnoc) +import Data.Monoid (Endo (..)) +import Development.IDE.GHC.Compat +import GHC.SourceGen (var) +import GHC.SourceGen.Expr (lambda) +import Wingman.CodeGen.Utils +import Wingman.GHC (containsHsVar, fromPatCompatPs) ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs similarity index 96% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs rename to plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index 7af41cbacd..28819914cb 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -6,8 +6,8 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeApplications #-} -module Ide.Plugin.Tactic.Tactics - ( module Ide.Plugin.Tactic.Tactics +module Wingman.Tactics + ( module Wingman.Tactics , runTactic ) where @@ -29,18 +29,18 @@ import Development.IDE.GHC.Compat import GHC.Exts import GHC.SourceGen.Expr import GHC.SourceGen.Overloaded -import Ide.Plugin.Tactic.CodeGen -import Ide.Plugin.Tactic.Context -import Ide.Plugin.Tactic.GHC -import Ide.Plugin.Tactic.Judgements -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Naming -import Ide.Plugin.Tactic.Types import Name (occNameString, occName) import Refinery.Tactic import Refinery.Tactic.Internal import TcType import Type hiding (Var) +import Wingman.CodeGen +import Wingman.Context +import Wingman.GHC +import Wingman.Judgements +import Wingman.Machinery +import Wingman.Naming +import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs similarity index 98% rename from plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs rename to plugins/hls-tactics-plugin/src/Wingman/Types.hs index 72e4daa823..91afab27cd 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -13,9 +13,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Ide.Plugin.Tactic.Types - ( module Ide.Plugin.Tactic.Types - , module Ide.Plugin.Tactic.Debug +module Wingman.Types + ( module Wingman.Types + , module Wingman.Debug , OccName , Name , Type @@ -35,22 +35,22 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Semigroup import Data.Set (Set) -import qualified Data.Text as T import Data.Text (Text) +import qualified Data.Text as T import Data.Tree import Development.IDE.GHC.Compat hiding (Node) import Development.IDE.GHC.Orphans () import Development.IDE.Types.Location import GHC.Generics import GHC.SourceGen (var) -import Ide.Plugin.Tactic.Debug -import Ide.Plugin.Tactic.FeatureSet import OccName import Refinery.Tactic import System.IO.Unsafe (unsafePerformIO) import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst) import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique) +import Wingman.Debug +import Wingman.FeatureSet ------------------------------------------------------------------------------ @@ -436,7 +436,7 @@ rose a rs = Rose $ Node a $ coerce rs ------------------------------------------------------------------------------ --- | The results of 'Ide.Plugin.Tactic.Machinery.runTactic' +-- | The results of 'Wingman.Machinery.runTactic' data RunTacticResults = RunTacticResults { rtr_trace :: Trace , rtr_extract :: LHsExpr GhcPs diff --git a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs index 2681c0acc0..4d721b4475 100644 --- a/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs +++ b/plugins/hls-tactics-plugin/test/AutoTupleSpec.hs @@ -3,10 +3,10 @@ module AutoTupleSpec where import Data.Either (isRight) -import Ide.Plugin.Tactic.Judgements (mkFirstJudgement) -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Tactics (auto') -import Ide.Plugin.Tactic.Types +import Wingman.Judgements (mkFirstJudgement) +import Wingman.Machinery +import Wingman.Tactics (auto') +import Wingman.Types import OccName (mkVarOcc) import Test.Hspec import Test.QuickCheck diff --git a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs index c448bf8715..799495d8af 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs @@ -7,10 +7,10 @@ module CodeAction.AutoSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils -import Ide.Plugin.Tactic.FeatureSet (allFeatures) +import Wingman.FeatureSet (allFeatures) spec :: Spec diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs index 77db7fa335..5e5a11fe0f 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs @@ -7,7 +7,7 @@ module CodeAction.DestructAllSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs index f330f1288a..2757f3b56a 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs @@ -7,7 +7,7 @@ module CodeAction.DestructSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils diff --git a/plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs index d209df207c..821e48a61b 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs @@ -7,7 +7,7 @@ module CodeAction.IntrosSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils diff --git a/plugins/hls-tactics-plugin/test/CodeAction/RefineSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/RefineSpec.hs index 813f6d60e6..12f1f9ce8a 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/RefineSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/RefineSpec.hs @@ -7,10 +7,10 @@ module CodeAction.RefineSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils -import Ide.Plugin.Tactic.FeatureSet (allFeatures) +import Wingman.FeatureSet (allFeatures) spec :: Spec diff --git a/plugins/hls-tactics-plugin/test/CodeAction/UseDataConSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/UseDataConSpec.hs index d3f9b110b7..676111bc6f 100644 --- a/plugins/hls-tactics-plugin/test/CodeAction/UseDataConSpec.hs +++ b/plugins/hls-tactics-plugin/test/CodeAction/UseDataConSpec.hs @@ -8,7 +8,7 @@ module CodeAction.UseDataConSpec where import qualified Data.Text as T -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils diff --git a/plugins/hls-tactics-plugin/test/ProviderSpec.hs b/plugins/hls-tactics-plugin/test/ProviderSpec.hs index 3db52ebd6f..0121c3078e 100644 --- a/plugins/hls-tactics-plugin/test/ProviderSpec.hs +++ b/plugins/hls-tactics-plugin/test/ProviderSpec.hs @@ -7,7 +7,7 @@ module ProviderSpec where -import Ide.Plugin.Tactic.Types +import Wingman.Types import Test.Hspec import Utils diff --git a/plugins/hls-tactics-plugin/test/UnificationSpec.hs b/plugins/hls-tactics-plugin/test/UnificationSpec.hs index ef47cbd174..954a507e12 100644 --- a/plugins/hls-tactics-plugin/test/UnificationSpec.hs +++ b/plugins/hls-tactics-plugin/test/UnificationSpec.hs @@ -10,9 +10,9 @@ import Data.Maybe (mapMaybe) import qualified Data.Set as S import Data.Traversable import Data.Tuple (swap) -import Ide.Plugin.Tactic.Debug -import Ide.Plugin.Tactic.Machinery -import Ide.Plugin.Tactic.Types +import Wingman.Debug +import Wingman.Machinery +import Wingman.Types import TcType (substTy, tcGetTyVar_maybe) import Test.Hspec import Test.QuickCheck diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index d0d4a15335..6ede016ae7 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -19,9 +19,9 @@ import Data.Maybe import Data.Text (Text) import qualified Data.Text.IO as T import qualified Ide.Plugin.Config as Plugin -import Ide.Plugin.Tactic.FeatureSet (FeatureSet, allFeatures) -import Ide.Plugin.Tactic.LanguageServer (mkShowMessageParams) -import Ide.Plugin.Tactic.Types +import Wingman.FeatureSet (FeatureSet, allFeatures) +import Wingman.LanguageServer (mkShowMessageParams) +import Wingman.Types import Language.LSP.Test import Language.LSP.Types import Language.LSP.Types.Lens hiding (actions, applyEdit, capabilities, executeCommand, id, line, message, name, rename, title) From 3afba0dd4bb72465107da58d58d44e82b98aebde Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 7 Mar 2021 14:30:24 -0800 Subject: [PATCH 2/5] Update cabal file with default extensions and Wall --- .../hls-tactics-plugin.cabal | 22 ++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 95fc785aac..802664f4da 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -47,6 +47,7 @@ library ghc-options: -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors + -Wall if flag(pedantic) ghc-options: -Werror @@ -77,7 +78,26 @@ library , deepseq default-language: Haskell2010 - default-extensions: DataKinds, TypeOperators + default-extensions: + DataKinds, + DeriveFunctor, + DeriveGeneric, + DeriveDataTypeable, + DeriveFoldable, + DeriveTraversable, + DerivingStrategies, + DerivingVia, + FlexibleContexts, + FlexibleInstances, + GADTs, + GeneralizedNewtypeDeriving, + LambdaCase, + MultiParamTypeClasses, + PatternSynonyms, + ScopedTypeVariables, + TypeApplications, + TypeOperators, + ViewPatterns executable test-server From bd1424be8e66337afe2c0b3572018cff708c838f Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 7 Mar 2021 14:35:38 -0800 Subject: [PATCH 3/5] Remove language extensions from files --- .../hls-tactics-plugin.cabal | 3 ++ .../src/Ide/Plugin/Tactic.hs | 8 +--- .../src/Wingman/CaseSplit.hs | 5 --- .../src/Wingman/CodeGen/Utils.hs | 2 - .../hls-tactics-plugin/src/Wingman/Context.hs | 3 -- .../src/Wingman/FeatureSet.hs | 1 - plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 10 +---- .../src/Wingman/Judgements.hs | 3 -- .../src/Wingman/KnownStrategies.hs | 2 - .../src/Wingman/KnownStrategies/QuickCheck.hs | 45 +++++++++---------- .../src/Wingman/LanguageServer.hs | 10 +---- .../Wingman/LanguageServer/TacticProviders.hs | 7 +-- .../src/Wingman/Machinery.hs | 9 ---- .../hls-tactics-plugin/src/Wingman/Naming.hs | 2 - .../src/Wingman/Simplify.hs | 6 +-- .../hls-tactics-plugin/src/Wingman/Tactics.hs | 8 ---- .../hls-tactics-plugin/src/Wingman/Types.hs | 18 ++------ 17 files changed, 35 insertions(+), 107 deletions(-) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 802664f4da..d78be4e8da 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -80,6 +80,7 @@ library default-language: Haskell2010 default-extensions: DataKinds, + DeriveAnyClass, DeriveFunctor, DeriveGeneric, DeriveDataTypeable, @@ -93,6 +94,8 @@ library GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, + NumDecimals, + OverloadedLabels, PatternSynonyms, ScopedTypeVariables, TypeApplications, diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index 793445f96c..4361bf1487 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -1,10 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NumDecimals #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} -- | A plugin that uses tactics to synthesize code module Ide.Plugin.Tactic diff --git a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs index 231661cd0f..8083240951 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} - module Wingman.CaseSplit ( mkFirstAgda , iterateSplit diff --git a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs index db8b837a41..4a0a0d07db 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/CodeGen/Utils.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} - module Wingman.CodeGen.Utils where import Data.List diff --git a/plugins/hls-tactics-plugin/src/Wingman/Context.hs b/plugins/hls-tactics-plugin/src/Wingman/Context.hs index 8154a7c7b8..00cae77f11 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Context.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Context.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} - module Wingman.Context where import Bag diff --git a/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs b/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs index f6f8f47c3b..a36f2da49a 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/FeatureSet.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} module Wingman.FeatureSet ( Feature (..) diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index 11b350550f..a02d9e29f4 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -1,11 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Wingman.GHC where diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index cfba75e000..55efe6ea00 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} - module Wingman.Judgements where import Control.Arrow diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs index ff631adeea..21eb5b3359 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - module Wingman.KnownStrategies where import Control.Monad.Error.Class diff --git a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs index f3e53dafd3..50eb2d791e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/KnownStrategies/QuickCheck.hs @@ -1,29 +1,26 @@ -{-# LANGUAGE ViewPatterns #-} - module Wingman.KnownStrategies.QuickCheck where -import Control.Monad.Except (MonadError (throwError)) -import Data.Bool (bool) -import Data.Generics (everything, mkQ) -import Data.List (partition) -import DataCon (DataCon, dataConName) -import Development.IDE.GHC.Compat (GhcPs, HsExpr, noLoc) -import GHC.Exts (IsString (fromString)) -import GHC.List (foldl') -import GHC.SourceGen (int) -import GHC.SourceGen.Binds (match, valBind) -import GHC.SourceGen.Expr (case', lambda, let') -import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) -import GHC.SourceGen.Pat (conP) -import Wingman.CodeGen -import Wingman.Judgements (jGoal) -import Wingman.Machinery (tracePrim) -import Wingman.Types -import OccName (HasOccName (occName), mkVarOcc, - occNameString) -import Refinery.Tactic (goal, rule) -import TyCon (TyCon, tyConDataCons, tyConName) -import Type (splitTyConApp_maybe) +import Control.Monad.Except (MonadError (throwError)) +import Data.Bool (bool) +import Data.Generics (everything, mkQ) +import Data.List (partition) +import DataCon (DataCon, dataConName) +import Development.IDE.GHC.Compat (GhcPs, HsExpr, noLoc) +import GHC.Exts (IsString (fromString)) +import GHC.List (foldl') +import GHC.SourceGen (int) +import GHC.SourceGen.Binds (match, valBind) +import GHC.SourceGen.Expr (case', lambda, let') +import GHC.SourceGen.Overloaded (App ((@@)), HasList (list)) +import GHC.SourceGen.Pat (conP) +import OccName (HasOccName (occName), mkVarOcc, occNameString) +import Refinery.Tactic (goal, rule) +import TyCon (TyCon, tyConDataCons, tyConName) +import Type (splitTyConApp_maybe) +import Wingman.CodeGen +import Wingman.Judgements (jGoal) +import Wingman.Machinery (tracePrim) +import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs index fa284b3c67..914f7c74f7 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer.hs @@ -1,11 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Wingman.LanguageServer where diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs index 1fe79b143c..825285ce8c 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} module Wingman.LanguageServer.TacticProviders ( commandProvider diff --git a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs index 1df770d233..c737ff17a2 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Machinery.hs @@ -1,13 +1,4 @@ -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} module Wingman.Machinery where diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs index 9216194490..5ffcc7d279 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ViewPatterns #-} - module Wingman.Naming where import Control.Monad.State.Strict diff --git a/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs b/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs index 3042229a17..c21986cf51 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Simplify.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} module Wingman.Simplify ( simplify diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index 28819914cb..3923542027 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} - -{-# LANGUAGE TypeApplications #-} module Wingman.Tactics ( module Wingman.Tactics , runTactic diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index 91afab27cd..90ed050f20 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -1,17 +1,7 @@ -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} module Wingman.Types ( module Wingman.Types From 244a4ec469e5d2539a7ddfc23a9bbf3b71afe511 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 7 Mar 2021 14:40:37 -0800 Subject: [PATCH 4/5] Cleanup -Wall issues --- plugins/hls-tactics-plugin/hls-tactics-plugin.cabal | 3 +-- plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs | 7 +------ plugins/hls-tactics-plugin/src/Wingman/GHC.hs | 1 - plugins/hls-tactics-plugin/src/Wingman/Judgements.hs | 9 +++++---- plugins/hls-tactics-plugin/src/Wingman/Naming.hs | 1 - plugins/hls-tactics-plugin/src/Wingman/Tactics.hs | 5 +++-- plugins/hls-tactics-plugin/src/Wingman/Types.hs | 2 +- 7 files changed, 11 insertions(+), 17 deletions(-) diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index d78be4e8da..4e123844bd 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -46,8 +46,7 @@ library Wingman.Types ghc-options: - -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors - -Wall + -Wall -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors if flag(pedantic) ghc-options: -Werror diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index 4361bf1487..9365912d67 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -109,7 +109,7 @@ tacticCmd tac state (TacticParams uri range var_name) Just (Left ufm) -> do showUserFacingMessage ufm Just (Right edit) -> do - sendRequest + _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing edit) (const $ pure ()) @@ -129,11 +129,6 @@ mkErr :: ErrorCode -> T.Text -> ResponseError mkErr code err = ResponseError code err Nothing -joinNote :: e -> Maybe (Either e a) -> Either e a -joinNote e Nothing = Left e -joinNote _ (Just a) = a - - ------------------------------------------------------------------------------ -- | Turn a 'RunTacticResults' into concrete edits to make in the source -- document. diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs index a02d9e29f4..ccb68d1e5f 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs @@ -3,7 +3,6 @@ module Wingman.GHC where -import Control.Arrow import Control.Monad.State import Data.Function (on) import Data.Functor ((<&>)) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 55efe6ea00..24f262a019 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -208,12 +208,13 @@ jAncestryMap jdg = provAncestryOf :: Provenance -> Set OccName -provAncestryOf (TopLevelArgPrv o i i3) = S.singleton o -provAncestryOf (PatternMatchPrv (PatVal mo so ud i)) = maybe mempty S.singleton mo <> so -provAncestryOf (ClassMethodPrv uc) = mempty +provAncestryOf (TopLevelArgPrv o _ _) = S.singleton o +provAncestryOf (PatternMatchPrv (PatVal mo so _ _)) = + maybe mempty S.singleton mo <> so +provAncestryOf (ClassMethodPrv _) = mempty provAncestryOf UserPrv = mempty provAncestryOf RecursivePrv = mempty -provAncestryOf (DisallowedPrv d p2) = provAncestryOf p2 +provAncestryOf (DisallowedPrv _ p2) = provAncestryOf p2 ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs index 5ffcc7d279..810cb5311f 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs @@ -13,7 +13,6 @@ import TcType import TyCon import Type import TysWiredIn (listTyCon, pairTyCon, unitTyCon) -import Wingman.Types ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs index 3923542027..ef0e674748 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs @@ -238,7 +238,7 @@ splitDataCon dc = requireConcreteHole $ tracing ("splitDataCon:" <> show dc) $ rule $ \jdg -> do let g = jGoal jdg case splitTyConApp_maybe $ unCType g of - Just (tc, apps) -> do + Just (_, apps) -> do buildDataCon (unwhitelistingSplit jdg) dc apps Nothing -> throwError $ GoalMismatch "splitDataCon" g @@ -271,11 +271,12 @@ userSplit occ = do -- code action, send it as a string, and then look it up again. Can we push -- this over LSP somehow instead? case splitTyConApp_maybe $ unCType g of - Just (tc, apps) -> do + Just (tc, _) -> do case find (sloppyEqOccName occ . occName . dataConName) $ tyConDataCons tc of Just dc -> splitDataCon dc Nothing -> throwError $ NotInScope occ + Nothing -> throwError $ NotInScope occ ------------------------------------------------------------------------------ diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs index 90ed050f20..dfd96979c1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs @@ -278,7 +278,7 @@ type Judgement = Judgement' CType newtype ExtractM a = ExtractM { unExtractM :: Reader Context a } - deriving (Functor, Applicative, Monad, MonadReader Context) + deriving newtype (Functor, Applicative, Monad, MonadReader Context) ------------------------------------------------------------------------------ -- | Orphan instance for producing holes when attempting to solve tactics. From 46e225063f323297e4bcf1addc98038c0d081a19 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 7 Mar 2021 14:48:07 -0800 Subject: [PATCH 5/5] Rip out the plugin into its own Wingman module --- .../hls-tactics-plugin.cabal | 1 + .../src/Ide/Plugin/Tactic.hs | 259 +---------------- .../hls-tactics-plugin/src/Wingman/Plugin.hs | 267 ++++++++++++++++++ 3 files changed, 269 insertions(+), 258 deletions(-) create mode 100644 plugins/hls-tactics-plugin/src/Wingman/Plugin.hs diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 4e123844bd..705c55f6cb 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -40,6 +40,7 @@ library Wingman.LanguageServer.TacticProviders Wingman.Machinery Wingman.Naming + Wingman.Plugin Wingman.Range Wingman.Simplify Wingman.Tactics diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index 9365912d67..35ecf0dcfe 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | A plugin that uses tactics to synthesize code module Ide.Plugin.Tactic ( descriptor @@ -7,260 +5,5 @@ module Ide.Plugin.Tactic , TacticCommand (..) ) where -import Bag (bagToList, listToBag) -import Control.Exception (evaluate) -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Trans.Maybe -import Data.Aeson -import Data.Bifunctor (first) -import Data.Data (Data) -import Data.Foldable (for_) -import Data.Generics.Aliases (mkQ) -import Data.Generics.Schemes (everything) -import Data.Maybe -import Data.Monoid -import qualified Data.Text as T -import Data.Traversable -import Development.IDE.Core.Shake (IdeState (..)) -import Development.IDE.GHC.Compat -import Development.IDE.GHC.ExactPrint -import Ide.Types -import Language.LSP.Server -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import OccName -import Prelude hiding (span) -import System.Timeout -import Wingman.CaseSplit -import Wingman.GHC -import Wingman.LanguageServer -import Wingman.LanguageServer.TacticProviders -import Wingman.Range -import Wingman.Tactics -import Wingman.Types - - -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor plId = (defaultPluginDescriptor plId) - { pluginCommands - = fmap (\tc -> - PluginCommand - (tcCommandId tc) - (tacticDesc $ tcCommandName tc) - (tacticCmd $ commandTactic tc)) - [minBound .. maxBound] - , pluginHandlers = - mkPluginHandler STextDocumentCodeAction codeActionProvider - } - - - -codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction -codeActionProvider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range _ctx) - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - cfg <- getTacticConfig $ shakeExtras state - liftIO $ fromMaybeT (Right $ List []) $ do - (_, jdg, _, dflags) <- judgementForHole state nfp range $ cfg_feature_set cfg - actions <- lift $ - -- This foldMap is over the function monoid. - foldMap commandProvider [minBound .. maxBound] - dflags - cfg - plId - uri - range - jdg - pure $ Right $ List actions -codeActionProvider _ _ _ = pure $ Right $ List [] - - -showUserFacingMessage - :: MonadLsp cfg m - => UserFacingMessage - -> m (Either ResponseError a) -showUserFacingMessage ufm = do - showLspMessage $ mkShowMessageParams ufm - pure $ Left $ mkErr InternalError $ T.pack $ show ufm - - -tacticCmd :: (OccName -> TacticsM ()) -> CommandFunction IdeState TacticParams -tacticCmd tac state (TacticParams uri range var_name) - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - features <- getFeatureSet $ shakeExtras state - ccs <- getClientCapabilities - res <- liftIO $ runMaybeT $ do - (range', jdg, ctx, dflags) <- judgementForHole state nfp range features - let span = rangeToRealSrcSpan (fromNormalizedFilePath nfp) range' - pm <- MaybeT $ useAnnotatedSource "tacticsCmd" state nfp - - timingOut 2e8 $ join $ - case runTactic ctx jdg $ tac $ mkVarOcc $ T.unpack var_name of - Left _ -> Left TacticErrors - Right rtr -> - case rtr_extract rtr of - L _ (HsVar _ (L _ rdr)) | isHole (occName rdr) -> - Left NothingToDo - _ -> pure $ mkWorkspaceEdits span dflags ccs uri pm rtr - - case res of - Nothing -> do - showUserFacingMessage TimedOut - Just (Left ufm) -> do - showUserFacingMessage ufm - Just (Right edit) -> do - _ <- sendRequest - SWorkspaceApplyEdit - (ApplyWorkspaceEditParams Nothing edit) - (const $ pure ()) - pure $ Right Null -tacticCmd _ _ _ = - pure $ Left $ mkErr InvalidRequest "Bad URI" - - -timingOut - :: Int -- ^ Time in microseconds - -> a -- ^ Computation to run - -> MaybeT IO a -timingOut t m = MaybeT $ timeout t $ evaluate m - - -mkErr :: ErrorCode -> T.Text -> ResponseError -mkErr code err = ResponseError code err Nothing - - ------------------------------------------------------------------------------- --- | Turn a 'RunTacticResults' into concrete edits to make in the source --- document. -mkWorkspaceEdits - :: RealSrcSpan - -> DynFlags - -> ClientCapabilities - -> Uri - -> Annotated ParsedSource - -> RunTacticResults - -> Either UserFacingMessage WorkspaceEdit -mkWorkspaceEdits span dflags ccs uri pm rtr = do - for_ (rtr_other_solns rtr) $ traceMX "other solution" - traceMX "solution" $ rtr_extract rtr - let g = graftHole (RealSrcSpan span) rtr - response = transform dflags ccs uri g pm - in first (InfrastructureError . T.pack) response - - ------------------------------------------------------------------------------- --- | Graft a 'RunTacticResults' into the correct place in an AST. Correctly --- deals with top-level holes, in which we might need to fiddle with the --- 'Match's that bind variables. -graftHole - :: SrcSpan - -> RunTacticResults - -> Graft (Either String) ParsedSource -graftHole span rtr - | _jIsTopHole (rtr_jdg rtr) - = graftSmallestDeclsWithM span - $ graftDecl span $ \pats -> - splitToDecl (fst $ last $ ctxDefiningFuncs $ rtr_ctx rtr) - $ iterateSplit - $ mkFirstAgda (fmap unXPat pats) - $ unLoc - $ rtr_extract rtr -graftHole span rtr - = graft span - $ rtr_extract rtr - - ------------------------------------------------------------------------------- --- | Merge in the 'Match'es of a 'FunBind' into a 'HsDecl'. Used to perform --- agda-style case splitting in which we need to separate one 'Match' into --- many, without affecting any matches which might exist but don't need to be --- split. -mergeFunBindMatches - :: ([Pat GhcPs] -> LHsDecl GhcPs) - -> SrcSpan - -> HsBind GhcPs - -> Either String (HsBind GhcPs) -mergeFunBindMatches make_decl span - (fb@FunBind {fun_matches = mg@MG {mg_alts = L alts_src alts}}) = - pure $ fb - { fun_matches = mg - { mg_alts = L alts_src $ do - alt@(L alt_src match) <- alts - case span `isSubspanOf` alt_src of - True -> do - let pats = fmap fromPatCompatPs $ m_pats match - L _ (ValD _ (FunBind {fun_matches = MG - {mg_alts = L _ to_add}})) = make_decl pats - to_add - False -> pure alt - } - } -mergeFunBindMatches _ _ _ = - Left "mergeFunBindMatches: called on something that isnt a funbind" - - -throwError :: String -> TransformT (Either String) a -throwError = lift . Left - - ------------------------------------------------------------------------------- --- | Helper function to route 'mergeFunBindMatches' into the right place in an --- AST --- correctly dealing with inserting into instance declarations. -graftDecl - :: SrcSpan - -> ([Pat GhcPs] -> LHsDecl GhcPs) - -> LHsDecl GhcPs - -> TransformT (Either String) (Maybe [LHsDecl GhcPs]) -graftDecl span - make_decl - (L src (ValD ext fb)) - = either throwError (pure . Just . pure . L src . ValD ext) $ - mergeFunBindMatches make_decl span fb --- TODO(sandy): add another case for default methods in class definitions -graftDecl span - make_decl - (L src (InstD ext - cid@ClsInstD{cid_inst = - cidi@ClsInstDecl{cid_sigs = _sigs, cid_binds = binds}})) - = do - binds' <- - for (bagToList binds) $ \b@(L bsrc bind) -> do - case bind of - fb@FunBind{} | span `isSubspanOf` bsrc -> - either throwError (pure . L bsrc) $ - mergeFunBindMatches make_decl span fb - _ -> pure b - - pure $ Just $ pure $ L src $ InstD ext $ cid - { cid_inst = cidi - { cid_binds = listToBag binds' - } - } -graftDecl span _ x = do - traceMX "biggest" $ - unsafeRender $ - locateBiggest @(Match GhcPs (LHsExpr GhcPs)) span x - traceMX "first" $ - unsafeRender $ - locateFirst @(Match GhcPs (LHsExpr GhcPs)) x - throwError "graftDecl: don't know about this AST form" - - -fromMaybeT :: Functor m => a -> MaybeT m a -> m a -fromMaybeT def = fmap (fromMaybe def) . runMaybeT - - -locateBiggest :: (Data r, Data a) => SrcSpan -> a -> Maybe r -locateBiggest ss x = getFirst $ everything (<>) - ( mkQ mempty $ \case - L span r | ss `isSubspanOf` span -> pure r - _ -> mempty - ) x - - -locateFirst :: (Data r, Data a) => a -> Maybe r -locateFirst x = getFirst $ everything (<>) - ( mkQ mempty $ \case - r -> pure r - ) x +import Wingman.Plugin diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs new file mode 100644 index 0000000000..d2c2df7e2b --- /dev/null +++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | A plugin that uses tactics to synthesize code +module Wingman.Plugin + ( descriptor + , tacticTitle + , TacticCommand (..) + ) where + +import Bag (bagToList, listToBag) +import Control.Exception (evaluate) +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Trans.Maybe +import Data.Aeson +import Data.Bifunctor (first) +import Data.Data (Data) +import Data.Foldable (for_) +import Data.Generics.Aliases (mkQ) +import Data.Generics.Schemes (everything) +import Data.Maybe +import Data.Monoid +import qualified Data.Text as T +import Data.Traversable +import Development.IDE.Core.Shake (IdeState (..)) +import Development.IDE.GHC.Compat +import Development.IDE.GHC.ExactPrint +import Ide.Types +import Language.LSP.Server +import Language.LSP.Types +import Language.LSP.Types.Capabilities +import OccName +import Prelude hiding (span) +import System.Timeout +import Wingman.CaseSplit +import Wingman.GHC +import Wingman.LanguageServer +import Wingman.LanguageServer.TacticProviders +import Wingman.Range +import Wingman.Tactics +import Wingman.Types + + +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) + { pluginCommands + = fmap (\tc -> + PluginCommand + (tcCommandId tc) + (tacticDesc $ tcCommandName tc) + (tacticCmd $ commandTactic tc)) + [minBound .. maxBound] + , pluginHandlers = + mkPluginHandler STextDocumentCodeAction codeActionProvider + } + + + +codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction +codeActionProvider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range _ctx) + | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do + cfg <- getTacticConfig $ shakeExtras state + liftIO $ fromMaybeT (Right $ List []) $ do + (_, jdg, _, dflags) <- judgementForHole state nfp range $ cfg_feature_set cfg + actions <- lift $ + -- This foldMap is over the function monoid. + foldMap commandProvider [minBound .. maxBound] + dflags + cfg + plId + uri + range + jdg + pure $ Right $ List actions +codeActionProvider _ _ _ = pure $ Right $ List [] + + +showUserFacingMessage + :: MonadLsp cfg m + => UserFacingMessage + -> m (Either ResponseError a) +showUserFacingMessage ufm = do + showLspMessage $ mkShowMessageParams ufm + pure $ Left $ mkErr InternalError $ T.pack $ show ufm + + +tacticCmd :: (OccName -> TacticsM ()) -> CommandFunction IdeState TacticParams +tacticCmd tac state (TacticParams uri range var_name) + | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do + features <- getFeatureSet $ shakeExtras state + ccs <- getClientCapabilities + res <- liftIO $ runMaybeT $ do + (range', jdg, ctx, dflags) <- judgementForHole state nfp range features + let span = rangeToRealSrcSpan (fromNormalizedFilePath nfp) range' + pm <- MaybeT $ useAnnotatedSource "tacticsCmd" state nfp + + timingOut 2e8 $ join $ + case runTactic ctx jdg $ tac $ mkVarOcc $ T.unpack var_name of + Left _ -> Left TacticErrors + Right rtr -> + case rtr_extract rtr of + L _ (HsVar _ (L _ rdr)) | isHole (occName rdr) -> + Left NothingToDo + _ -> pure $ mkWorkspaceEdits span dflags ccs uri pm rtr + + case res of + Nothing -> do + showUserFacingMessage TimedOut + Just (Left ufm) -> do + showUserFacingMessage ufm + Just (Right edit) -> do + _ <- sendRequest + SWorkspaceApplyEdit + (ApplyWorkspaceEditParams Nothing edit) + (const $ pure ()) + pure $ Right Null +tacticCmd _ _ _ = + pure $ Left $ mkErr InvalidRequest "Bad URI" + + +timingOut + :: Int -- ^ Time in microseconds + -> a -- ^ Computation to run + -> MaybeT IO a +timingOut t m = MaybeT $ timeout t $ evaluate m + + +mkErr :: ErrorCode -> T.Text -> ResponseError +mkErr code err = ResponseError code err Nothing + + +------------------------------------------------------------------------------ +-- | Turn a 'RunTacticResults' into concrete edits to make in the source +-- document. +mkWorkspaceEdits + :: RealSrcSpan + -> DynFlags + -> ClientCapabilities + -> Uri + -> Annotated ParsedSource + -> RunTacticResults + -> Either UserFacingMessage WorkspaceEdit +mkWorkspaceEdits span dflags ccs uri pm rtr = do + for_ (rtr_other_solns rtr) $ traceMX "other solution" + traceMX "solution" $ rtr_extract rtr + let g = graftHole (RealSrcSpan span) rtr + response = transform dflags ccs uri g pm + in first (InfrastructureError . T.pack) response + + +------------------------------------------------------------------------------ +-- | Graft a 'RunTacticResults' into the correct place in an AST. Correctly +-- deals with top-level holes, in which we might need to fiddle with the +-- 'Match's that bind variables. +graftHole + :: SrcSpan + -> RunTacticResults + -> Graft (Either String) ParsedSource +graftHole span rtr + | _jIsTopHole (rtr_jdg rtr) + = graftSmallestDeclsWithM span + $ graftDecl span $ \pats -> + splitToDecl (fst $ last $ ctxDefiningFuncs $ rtr_ctx rtr) + $ iterateSplit + $ mkFirstAgda (fmap unXPat pats) + $ unLoc + $ rtr_extract rtr +graftHole span rtr + = graft span + $ rtr_extract rtr + + +------------------------------------------------------------------------------ +-- | Merge in the 'Match'es of a 'FunBind' into a 'HsDecl'. Used to perform +-- agda-style case splitting in which we need to separate one 'Match' into +-- many, without affecting any matches which might exist but don't need to be +-- split. +mergeFunBindMatches + :: ([Pat GhcPs] -> LHsDecl GhcPs) + -> SrcSpan + -> HsBind GhcPs + -> Either String (HsBind GhcPs) +mergeFunBindMatches make_decl span + (fb@FunBind {fun_matches = mg@MG {mg_alts = L alts_src alts}}) = + pure $ fb + { fun_matches = mg + { mg_alts = L alts_src $ do + alt@(L alt_src match) <- alts + case span `isSubspanOf` alt_src of + True -> do + let pats = fmap fromPatCompatPs $ m_pats match + L _ (ValD _ (FunBind {fun_matches = MG + {mg_alts = L _ to_add}})) = make_decl pats + to_add + False -> pure alt + } + } +mergeFunBindMatches _ _ _ = + Left "mergeFunBindMatches: called on something that isnt a funbind" + + +throwError :: String -> TransformT (Either String) a +throwError = lift . Left + + +------------------------------------------------------------------------------ +-- | Helper function to route 'mergeFunBindMatches' into the right place in an +-- AST --- correctly dealing with inserting into instance declarations. +graftDecl + :: SrcSpan + -> ([Pat GhcPs] -> LHsDecl GhcPs) + -> LHsDecl GhcPs + -> TransformT (Either String) (Maybe [LHsDecl GhcPs]) +graftDecl span + make_decl + (L src (ValD ext fb)) + = either throwError (pure . Just . pure . L src . ValD ext) $ + mergeFunBindMatches make_decl span fb +-- TODO(sandy): add another case for default methods in class definitions +graftDecl span + make_decl + (L src (InstD ext + cid@ClsInstD{cid_inst = + cidi@ClsInstDecl{cid_sigs = _sigs, cid_binds = binds}})) + = do + binds' <- + for (bagToList binds) $ \b@(L bsrc bind) -> do + case bind of + fb@FunBind{} | span `isSubspanOf` bsrc -> + either throwError (pure . L bsrc) $ + mergeFunBindMatches make_decl span fb + _ -> pure b + + pure $ Just $ pure $ L src $ InstD ext $ cid + { cid_inst = cidi + { cid_binds = listToBag binds' + } + } +graftDecl span _ x = do + traceMX "biggest" $ + unsafeRender $ + locateBiggest @(Match GhcPs (LHsExpr GhcPs)) span x + traceMX "first" $ + unsafeRender $ + locateFirst @(Match GhcPs (LHsExpr GhcPs)) x + throwError "graftDecl: don't know about this AST form" + + +fromMaybeT :: Functor m => a -> MaybeT m a -> m a +fromMaybeT def = fmap (fromMaybe def) . runMaybeT + + +locateBiggest :: (Data r, Data a) => SrcSpan -> a -> Maybe r +locateBiggest ss x = getFirst $ everything (<>) + ( mkQ mempty $ \case + L span r | ss `isSubspanOf` span -> pure r + _ -> mempty + ) x + + +locateFirst :: (Data r, Data a) => a -> Maybe r +locateFirst x = getFirst $ everything (<>) + ( mkQ mempty $ \case + r -> pure r + ) x + +