Organize Wingman tests

plugins/hls-tactics-plugin/hls-tactics-plugin.cabal

@@ -44,7 +44,6 @@ library
     Ide.Plugin.Tactic.Simplify
     Ide.Plugin.Tactic.Tactics
     Ide.Plugin.Tactic.Types
-    Ide.Plugin.Tactic.TestTypes
 
   ghc-options:
     -Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors
@@ -101,8 +100,15 @@ test-suite tests
   main-is: Main.hs
   other-modules:
     AutoTupleSpec
-    GoldenSpec
+    CodeAction.AutoSpec
+    CodeAction.DestructAllSpec
+    CodeAction.RefineSpec
+    CodeAction.DestructSpec
+    CodeAction.IntrosSpec
+    CodeAction.UseDataConSpec
+    ProviderSpec
     UnificationSpec
+    Utils
   hs-source-dirs:
       test
   ghc-options: -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs

@@ -40,7 +40,6 @@ 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.TestTypes
 import           Ide.Plugin.Tactic.Types
 import           Ide.Types
 import           Language.LSP.Server

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs

@@ -45,7 +45,6 @@ import           Ide.Plugin.Tactic.FeatureSet
 import           Ide.Plugin.Tactic.GHC
 import           Ide.Plugin.Tactic.Judgements
 import           Ide.Plugin.Tactic.Range
-import           Ide.Plugin.Tactic.TestTypes (TacticCommand, cfg_feature_set, emptyConfig, Config)
 import           Ide.Plugin.Tactic.Types
 import           Language.LSP.Server (MonadLsp)
 import           Language.LSP.Types

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs

@@ -31,7 +31,6 @@ import           Ide.Plugin.Tactic.FeatureSet
 import           Ide.Plugin.Tactic.GHC
 import           Ide.Plugin.Tactic.Judgements
 import           Ide.Plugin.Tactic.Tactics
-import           Ide.Plugin.Tactic.TestTypes
 import           Ide.Plugin.Tactic.Types
 import           Ide.PluginUtils
 import           Ide.Types

plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs

@@ -8,7 +8,9 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE TypeApplications           #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans       #-}
 
 module Ide.Plugin.Tactic.Types
@@ -22,29 +24,88 @@ module Ide.Plugin.Tactic.Types
   , Range
   ) where
 
-import Control.Lens hiding (Context, (.=))
-import Control.Monad.Reader
-import Control.Monad.State
-import Data.Coerce
-import Data.Function
-import Data.Generics.Product (field)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Semigroup
-import Data.Set (Set)
-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 (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           Control.Lens hiding (Context, (.=))
+import           Control.Monad.Reader
+import           Control.Monad.State
+import           Data.Aeson
+import           Data.Coerce
+import           Data.Function
+import           Data.Generics.Product (field)
+import           Data.List.NonEmpty (NonEmpty (..))
+import           Data.Maybe (fromMaybe)
+import           Data.Semigroup
+import           Data.Set (Set)
+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           Ide.Plugin.Tactic.FeatureSet (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)
+
+
+------------------------------------------------------------------------------
+-- | The list of tactics exposed to the outside world. These are attached to
+-- actual tactics via 'commandTactic' and are contextually provided to the
+-- editor via 'commandProvider'.
+data TacticCommand
+  = Auto
+  | Intros
+  | Destruct
+  | Homomorphism
+  | DestructLambdaCase
+  | HomomorphismLambdaCase
+  | DestructAll
+  | UseDataCon
+  | Refine
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+-- | Generate a title for the command.
+tacticTitle :: TacticCommand -> T.Text -> T.Text
+tacticTitle Auto _                   = "Attempt to fill hole"
+tacticTitle Intros _                 = "Introduce lambda"
+tacticTitle Destruct var             = "Case split on " <> var
+tacticTitle Homomorphism var         = "Homomorphic case split on " <> var
+tacticTitle DestructLambdaCase _     = "Lambda case split"
+tacticTitle HomomorphismLambdaCase _ = "Homomorphic lambda case split"
+tacticTitle DestructAll _            = "Split all function arguments"
+tacticTitle UseDataCon dcon          = "Use constructor " <> dcon
+tacticTitle Refine _                 = "Refine hole"
+
+
+------------------------------------------------------------------------------
+-- | Plugin configuration for tactics
+data Config = Config
+  { cfg_feature_set          :: FeatureSet
+  , cfg_max_use_ctor_actions :: Int
+  }
+
+emptyConfig :: Config
+emptyConfig = Config defaultFeatures 5
+
+
+instance ToJSON Config where
+  toJSON Config{..} = object
+    [ "features" .= prettyFeatureSet cfg_feature_set
+    , "max_use_ctor_actions" .= cfg_max_use_ctor_actions
+    ]
+
+instance FromJSON Config where
+  parseJSON = withObject "Config" $ \obj -> do
+    cfg_feature_set          <-
+      parseFeatureSet . fromMaybe "" <$> obj .:? "features"
+    cfg_max_use_ctor_actions <-
+      fromMaybe 5 <$> obj .:? "max_use_ctor_actions"
+    pure $ Config{..}
 
 
 ------------------------------------------------------------------------------

plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module CodeAction.AutoSpec where
+
+import Ide.Plugin.Tactic.Types
+import Test.Hspec
+import Utils
+
+
+spec :: Spec
+spec = do
+  let autoTest = goldenTest Auto ""
+
+  describe "golden tests" $ do
+    autoTest 11  8 "AutoSplitGADT.hs"
+    autoTest  2 11 "GoldenEitherAuto.hs"
+    autoTest  4 12 "GoldenJoinCont.hs"
+    autoTest  3 11 "GoldenIdentityFunctor.hs"
+    autoTest  7 11 "GoldenIdTypeFam.hs"
+    autoTest  2 15 "GoldenEitherHomomorphic.hs"
+    autoTest  2  8 "GoldenNote.hs"
+    autoTest  2 12 "GoldenPureList.hs"
+    autoTest  2 12 "GoldenListFmap.hs"
+    autoTest  2 13 "GoldenFromMaybe.hs"
+    autoTest  2 10 "GoldenFoldr.hs"
+    autoTest  2  8 "GoldenSwap.hs"
+    autoTest  4 11 "GoldenFmapTree.hs"
+    autoTest  7 13 "GoldenGADTAuto.hs"
+    autoTest  2 12 "GoldenSwapMany.hs"
+    autoTest  4 12 "GoldenBigTuple.hs"
+    autoTest  2 10 "GoldenShow.hs"
+    autoTest  2 15 "GoldenShowCompose.hs"
+    autoTest  2  8 "GoldenShowMapChar.hs"
+    autoTest  7  8 "GoldenSuperclass.hs"
+    autoTest  2 12 "GoldenSafeHead.hs"
+    autoTest 25 13 "GoldenArbitrary.hs"
+    autoTest  2 12 "FmapBoth.hs"
+    autoTest  7  8 "RecordCon.hs"
+    autoTest  6  8 "NewtypeRecord.hs"
+    autoTest  2 14 "FmapJoin.hs"
+    autoTest  2  9 "Fgmap.hs"
+    autoTest  4 19 "FmapJoinInLet.hs"
+
+    failing "flaky in CI" $
+      autoTest 2 11 "GoldenApplicativeThen.hs"
+
+    failing "not enough auto gas" $
+      autoTest 5 18 "GoldenFish.hs"
+

plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module CodeAction.DestructAllSpec where
+
+import Ide.Plugin.Tactic.Types
+import Test.Hspec
+import Utils
+
+
+spec :: Spec
+spec = do
+  let destructAllTest = goldenTest DestructAll ""
+  describe "provider" $ do
+    mkTest
+      "Requires args on lhs of ="
+      "DestructAllProvider.hs" 3 21
+      [ (not, DestructAll, "")
+      ]
+    mkTest
+      "Can't be a non-top-hole"
+      "DestructAllProvider.hs" 8 19
+      [ (not, DestructAll, "")
+      , (id, Destruct, "a")
+      , (id, Destruct, "b")
+      ]
+    mkTest
+      "Provides a destruct all otherwise"
+      "DestructAllProvider.hs" 12 22
+      [ (id, DestructAll, "")
+      ]
+
+  describe "golden" $ do
+    destructAllTest 2 11 "DestructAllAnd.hs"
+    destructAllTest 4 23 "DestructAllMany.hs"
+    destructAllTest 2 18 "DestructAllNonVarTopMatch.hs"
+

plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module CodeAction.DestructSpec where
+
+import Ide.Plugin.Tactic.Types
+import Test.Hspec
+import Utils
+
+
+spec :: Spec
+spec = do
+  let destructTest = goldenTest Destruct
+
+  describe "golden" $ do
+    destructTest "gadt" 7 17 "GoldenGADTDestruct.hs"
+    destructTest "gadt" 8 17 "GoldenGADTDestructCoercion.hs"
+    destructTest "a"    7 25 "SplitPattern.hs"
+
+  describe "layout" $ do
+    destructTest "b" 4  3 "LayoutBind.hs"
+    destructTest "b" 2 15 "LayoutDollarApp.hs"
+    destructTest "b" 2 18 "LayoutOpApp.hs"
+    destructTest "b" 2 14 "LayoutLam.hs"
+

plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module CodeAction.IntrosSpec where
+
+import Ide.Plugin.Tactic.Types
+import Test.Hspec
+import Utils
+
+
+spec :: Spec
+spec = do
+  let introsTest = goldenTest Intros ""
+
+  describe "golden" $ do
+    introsTest 2 8 "GoldenIntros.hs"
+