Skip to content

Commit db72348

Browse files
isovectormergify[bot]
isovector
and
mergify[bot]
authored
Organize Wingman tests (#1498)
* Split GoldenSpec into more manageable chunks * Move line/col arguments before file path for better alignment * Merge TestTypes into Types Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent b805746 commit db72348

15 files changed

+506
-402
lines changed

Diff for: ‎plugins/hls-tactics-plugin/hls-tactics-plugin.cabal

+8-2
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,6 @@ library
4444
Ide.Plugin.Tactic.Simplify
4545
Ide.Plugin.Tactic.Tactics
4646
Ide.Plugin.Tactic.Types
47-
Ide.Plugin.Tactic.TestTypes
4847

4948
ghc-options:
5049
-Wno-name-shadowing -Wredundant-constraints -Wno-unticked-promoted-constructors
@@ -101,8 +100,15 @@ test-suite tests
101100
main-is: Main.hs
102101
other-modules:
103102
AutoTupleSpec
104-
GoldenSpec
103+
CodeAction.AutoSpec
104+
CodeAction.DestructAllSpec
105+
CodeAction.RefineSpec
106+
CodeAction.DestructSpec
107+
CodeAction.IntrosSpec
108+
CodeAction.UseDataConSpec
109+
ProviderSpec
105110
UnificationSpec
111+
Utils
106112
hs-source-dirs:
107113
test
108114
ghc-options: -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N

Diff for: ‎plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs

-1
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,6 @@ import Ide.Plugin.Tactic.LanguageServer
4040
import Ide.Plugin.Tactic.LanguageServer.TacticProviders
4141
import Ide.Plugin.Tactic.Range
4242
import Ide.Plugin.Tactic.Tactics
43-
import Ide.Plugin.Tactic.TestTypes
4443
import Ide.Plugin.Tactic.Types
4544
import Ide.Types
4645
import Language.LSP.Server

Diff for: ‎plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs

-1
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,6 @@ import Ide.Plugin.Tactic.FeatureSet
4545
import Ide.Plugin.Tactic.GHC
4646
import Ide.Plugin.Tactic.Judgements
4747
import Ide.Plugin.Tactic.Range
48-
import Ide.Plugin.Tactic.TestTypes (TacticCommand, cfg_feature_set, emptyConfig, Config)
4948
import Ide.Plugin.Tactic.Types
5049
import Language.LSP.Server (MonadLsp)
5150
import Language.LSP.Types

Diff for: ‎plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer/TacticProviders.hs

-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,6 @@ import Ide.Plugin.Tactic.FeatureSet
3131
import Ide.Plugin.Tactic.GHC
3232
import Ide.Plugin.Tactic.Judgements
3333
import Ide.Plugin.Tactic.Tactics
34-
import Ide.Plugin.Tactic.TestTypes
3534
import Ide.Plugin.Tactic.Types
3635
import Ide.PluginUtils
3736
import Ide.Types

Diff for: ‎plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs

-63
This file was deleted.

Diff for: ‎plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs

+84-23
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,9 @@
88
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
99
{-# LANGUAGE MultiParamTypeClasses #-}
1010
{-# LANGUAGE OverloadedStrings #-}
11+
{-# LANGUAGE RecordWildCards #-}
1112
{-# LANGUAGE TypeApplications #-}
13+
1214
{-# OPTIONS_GHC -fno-warn-orphans #-}
1315

1416
module Ide.Plugin.Tactic.Types
@@ -22,29 +24,88 @@ module Ide.Plugin.Tactic.Types
2224
, Range
2325
) where
2426

25-
import Control.Lens hiding (Context, (.=))
26-
import Control.Monad.Reader
27-
import Control.Monad.State
28-
import Data.Coerce
29-
import Data.Function
30-
import Data.Generics.Product (field)
31-
import Data.List.NonEmpty (NonEmpty (..))
32-
import Data.Semigroup
33-
import Data.Set (Set)
34-
import Data.Tree
35-
import Development.IDE.GHC.Compat hiding (Node)
36-
import Development.IDE.GHC.Orphans ()
37-
import Development.IDE.Types.Location
38-
import GHC.Generics
39-
import GHC.SourceGen (var)
40-
import Ide.Plugin.Tactic.Debug
41-
import Ide.Plugin.Tactic.FeatureSet (FeatureSet)
42-
import OccName
43-
import Refinery.Tactic
44-
import System.IO.Unsafe (unsafePerformIO)
45-
import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst)
46-
import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply)
47-
import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique)
27+
import Control.Lens hiding (Context, (.=))
28+
import Control.Monad.Reader
29+
import Control.Monad.State
30+
import Data.Aeson
31+
import Data.Coerce
32+
import Data.Function
33+
import Data.Generics.Product (field)
34+
import Data.List.NonEmpty (NonEmpty (..))
35+
import Data.Maybe (fromMaybe)
36+
import Data.Semigroup
37+
import Data.Set (Set)
38+
import qualified Data.Text as T
39+
import Data.Tree
40+
import Development.IDE.GHC.Compat hiding (Node)
41+
import Development.IDE.GHC.Orphans ()
42+
import Development.IDE.Types.Location
43+
import GHC.Generics
44+
import GHC.SourceGen (var)
45+
import Ide.Plugin.Tactic.Debug
46+
import Ide.Plugin.Tactic.FeatureSet
47+
import Ide.Plugin.Tactic.FeatureSet (FeatureSet)
48+
import OccName
49+
import Refinery.Tactic
50+
import System.IO.Unsafe (unsafePerformIO)
51+
import Type (TCvSubst, Var, eqType, nonDetCmpType, emptyTCvSubst)
52+
import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply)
53+
import Unique (nonDetCmpUnique, Uniquable, getUnique, Unique)
54+
55+
56+
------------------------------------------------------------------------------
57+
-- | The list of tactics exposed to the outside world. These are attached to
58+
-- actual tactics via 'commandTactic' and are contextually provided to the
59+
-- editor via 'commandProvider'.
60+
data TacticCommand
61+
= Auto
62+
| Intros
63+
| Destruct
64+
| Homomorphism
65+
| DestructLambdaCase
66+
| HomomorphismLambdaCase
67+
| DestructAll
68+
| UseDataCon
69+
| Refine
70+
deriving (Eq, Ord, Show, Enum, Bounded)
71+
72+
-- | Generate a title for the command.
73+
tacticTitle :: TacticCommand -> T.Text -> T.Text
74+
tacticTitle Auto _ = "Attempt to fill hole"
75+
tacticTitle Intros _ = "Introduce lambda"
76+
tacticTitle Destruct var = "Case split on " <> var
77+
tacticTitle Homomorphism var = "Homomorphic case split on " <> var
78+
tacticTitle DestructLambdaCase _ = "Lambda case split"
79+
tacticTitle HomomorphismLambdaCase _ = "Homomorphic lambda case split"
80+
tacticTitle DestructAll _ = "Split all function arguments"
81+
tacticTitle UseDataCon dcon = "Use constructor " <> dcon
82+
tacticTitle Refine _ = "Refine hole"
83+
84+
85+
------------------------------------------------------------------------------
86+
-- | Plugin configuration for tactics
87+
data Config = Config
88+
{ cfg_feature_set :: FeatureSet
89+
, cfg_max_use_ctor_actions :: Int
90+
}
91+
92+
emptyConfig :: Config
93+
emptyConfig = Config defaultFeatures 5
94+
95+
96+
instance ToJSON Config where
97+
toJSON Config{..} = object
98+
[ "features" .= prettyFeatureSet cfg_feature_set
99+
, "max_use_ctor_actions" .= cfg_max_use_ctor_actions
100+
]
101+
102+
instance FromJSON Config where
103+
parseJSON = withObject "Config" $ \obj -> do
104+
cfg_feature_set <-
105+
parseFeatureSet . fromMaybe "" <$> obj .:? "features"
106+
cfg_max_use_ctor_actions <-
107+
fromMaybe 5 <$> obj .:? "max_use_ctor_actions"
108+
pure $ Config{..}
48109

49110

50111
------------------------------------------------------------------------------

Diff for: ‎plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs

+54
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeOperators #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module CodeAction.AutoSpec where
9+
10+
import Ide.Plugin.Tactic.Types
11+
import Test.Hspec
12+
import Utils
13+
14+
15+
spec :: Spec
16+
spec = do
17+
let autoTest = goldenTest Auto ""
18+
19+
describe "golden tests" $ do
20+
autoTest 11 8 "AutoSplitGADT.hs"
21+
autoTest 2 11 "GoldenEitherAuto.hs"
22+
autoTest 4 12 "GoldenJoinCont.hs"
23+
autoTest 3 11 "GoldenIdentityFunctor.hs"
24+
autoTest 7 11 "GoldenIdTypeFam.hs"
25+
autoTest 2 15 "GoldenEitherHomomorphic.hs"
26+
autoTest 2 8 "GoldenNote.hs"
27+
autoTest 2 12 "GoldenPureList.hs"
28+
autoTest 2 12 "GoldenListFmap.hs"
29+
autoTest 2 13 "GoldenFromMaybe.hs"
30+
autoTest 2 10 "GoldenFoldr.hs"
31+
autoTest 2 8 "GoldenSwap.hs"
32+
autoTest 4 11 "GoldenFmapTree.hs"
33+
autoTest 7 13 "GoldenGADTAuto.hs"
34+
autoTest 2 12 "GoldenSwapMany.hs"
35+
autoTest 4 12 "GoldenBigTuple.hs"
36+
autoTest 2 10 "GoldenShow.hs"
37+
autoTest 2 15 "GoldenShowCompose.hs"
38+
autoTest 2 8 "GoldenShowMapChar.hs"
39+
autoTest 7 8 "GoldenSuperclass.hs"
40+
autoTest 2 12 "GoldenSafeHead.hs"
41+
autoTest 25 13 "GoldenArbitrary.hs"
42+
autoTest 2 12 "FmapBoth.hs"
43+
autoTest 7 8 "RecordCon.hs"
44+
autoTest 6 8 "NewtypeRecord.hs"
45+
autoTest 2 14 "FmapJoin.hs"
46+
autoTest 2 9 "Fgmap.hs"
47+
autoTest 4 19 "FmapJoinInLet.hs"
48+
49+
failing "flaky in CI" $
50+
autoTest 2 11 "GoldenApplicativeThen.hs"
51+
52+
failing "not enough auto gas" $
53+
autoTest 5 18 "GoldenFish.hs"
54+

Diff for: ‎plugins/hls-tactics-plugin/test/CodeAction/DestructAllSpec.hs

+41
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeOperators #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module CodeAction.DestructAllSpec where
9+
10+
import Ide.Plugin.Tactic.Types
11+
import Test.Hspec
12+
import Utils
13+
14+
15+
spec :: Spec
16+
spec = do
17+
let destructAllTest = goldenTest DestructAll ""
18+
describe "provider" $ do
19+
mkTest
20+
"Requires args on lhs of ="
21+
"DestructAllProvider.hs" 3 21
22+
[ (not, DestructAll, "")
23+
]
24+
mkTest
25+
"Can't be a non-top-hole"
26+
"DestructAllProvider.hs" 8 19
27+
[ (not, DestructAll, "")
28+
, (id, Destruct, "a")
29+
, (id, Destruct, "b")
30+
]
31+
mkTest
32+
"Provides a destruct all otherwise"
33+
"DestructAllProvider.hs" 12 22
34+
[ (id, DestructAll, "")
35+
]
36+
37+
describe "golden" $ do
38+
destructAllTest 2 11 "DestructAllAnd.hs"
39+
destructAllTest 4 23 "DestructAllMany.hs"
40+
destructAllTest 2 18 "DestructAllNonVarTopMatch.hs"
41+

Diff for: ‎plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs

+29
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeOperators #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module CodeAction.DestructSpec where
9+
10+
import Ide.Plugin.Tactic.Types
11+
import Test.Hspec
12+
import Utils
13+
14+
15+
spec :: Spec
16+
spec = do
17+
let destructTest = goldenTest Destruct
18+
19+
describe "golden" $ do
20+
destructTest "gadt" 7 17 "GoldenGADTDestruct.hs"
21+
destructTest "gadt" 8 17 "GoldenGADTDestructCoercion.hs"
22+
destructTest "a" 7 25 "SplitPattern.hs"
23+
24+
describe "layout" $ do
25+
destructTest "b" 4 3 "LayoutBind.hs"
26+
destructTest "b" 2 15 "LayoutDollarApp.hs"
27+
destructTest "b" 2 18 "LayoutOpApp.hs"
28+
destructTest "b" 2 14 "LayoutLam.hs"
29+

Diff for: ‎plugins/hls-tactics-plugin/test/CodeAction/IntrosSpec.hs

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeOperators #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module CodeAction.IntrosSpec where
9+
10+
import Ide.Plugin.Tactic.Types
11+
import Test.Hspec
12+
import Utils
13+
14+
15+
spec :: Spec
16+
spec = do
17+
let introsTest = goldenTest Intros ""
18+
19+
describe "golden" $ do
20+
introsTest 2 8 "GoldenIntros.hs"
21+

0 commit comments

Comments
 (0)