Skip to content

Commit b8701df

Browse files
authored
Merge branch 'master' into brittany-package
2 parents 3bcde6b + 7817a10 commit b8701df

File tree

4 files changed

+32
-8
lines changed

4 files changed

+32
-8
lines changed

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

+11-8
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ module Ide.Plugin.Tactic.CaseSplit
99
, splitToDecl
1010
) where
1111

12-
import Control.Lens
1312
import Data.Bool (bool)
1413
import Data.Data
1514
import Data.Generics
@@ -37,13 +36,9 @@ mkFirstAgda pats body = AgdaMatch pats body
3736
-- splitting it into multiple matches: one for each alternative of the case.
3837
agdaSplit :: AgdaMatch -> [AgdaMatch]
3938
agdaSplit (AgdaMatch pats (Case (HsVar _ (L _ var)) matches)) = do
40-
(i, pat) <- zip [id @Int 0 ..] pats
41-
case pat of
42-
VarPat _ (L _ patname) | eqRdrName patname var -> do
43-
(case_pat, body) <- matches
44-
-- TODO(sandy): use an at pattern if necessary
45-
pure $ AgdaMatch (pats & ix i .~ case_pat) body
46-
_ -> []
39+
(pat, body) <- matches
40+
-- TODO(sandy): use an at pattern if necessary
41+
pure $ AgdaMatch (rewriteVarPat var pat pats) body
4742
agdaSplit x = [x]
4843

4944

@@ -63,6 +58,14 @@ wildifyT (S.map occNameString -> used) = everywhere $ mkT $ \case
6358
(x :: Pat GhcPs) -> x
6459

6560

61+
------------------------------------------------------------------------------
62+
-- | Replace a 'VarPat' with the given @'Pat' GhcPs@.
63+
rewriteVarPat :: Data a => RdrName -> Pat GhcPs -> a -> a
64+
rewriteVarPat name rep = everywhere $ mkT $ \case
65+
VarPat _ (L _ var) | eqRdrName name var -> rep
66+
(x :: Pat GhcPs) -> x
67+
68+
6669
------------------------------------------------------------------------------
6770
-- | Construct an 'HsDecl' from a set of 'AgdaMatch'es.
6871
splitToDecl

test/functional/Tactic.hs

+1
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,7 @@ tests = testGroup
128128
, goldenTest "FmapJoin.hs" 2 14 Auto ""
129129
, goldenTest "Fgmap.hs" 2 9 Auto ""
130130
, goldenTest "FmapJoinInLet.hs" 4 19 Auto ""
131+
, goldenTest "SplitPattern.hs" 7 25 Destruct "a"
131132
]
132133

133134

test/testdata/tactic/SplitPattern.hs

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
data ADT = One | Two Int | Three | Four Bool ADT | Five
2+
3+
case_split :: ADT -> Int
4+
case_split One = _
5+
case_split (Two i) = _
6+
case_split Three = _
7+
case_split (Four b a) = _
8+
case_split Five = _
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
data ADT = One | Two Int | Three | Four Bool ADT | Five
2+
3+
case_split :: ADT -> Int
4+
case_split One = _
5+
case_split (Two i) = _
6+
case_split Three = _
7+
case_split (Four b One) = _
8+
case_split (Four b (Two i)) = _
9+
case_split (Four b Three) = _
10+
case_split (Four b (Four b2 a3)) = _
11+
case_split (Four b Five) = _
12+
case_split Five = _

0 commit comments

Comments
 (0)