Skip to content

Commit

Permalink
Successfully split non-varpats (#1427)
Browse files Browse the repository at this point in the history
  • Loading branch information
isovector authored Feb 23, 2021
1 parent ff86600 commit 7817a10
Show file tree
Hide file tree
Showing 4 changed files with 32 additions and 8 deletions.
19 changes: 11 additions & 8 deletions plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CaseSplit.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@ module Ide.Plugin.Tactic.CaseSplit
, splitToDecl
) where

import Control.Lens
import Data.Bool (bool)
import Data.Data
import Data.Generics
Expand Down Expand Up @@ -37,13 +36,9 @@ mkFirstAgda pats body = AgdaMatch pats body
-- splitting it into multiple matches: one for each alternative of the case.
agdaSplit :: AgdaMatch -> [AgdaMatch]
agdaSplit (AgdaMatch pats (Case (HsVar _ (L _ var)) matches)) = do
(i, pat) <- zip [id @Int 0 ..] pats
case pat of
VarPat _ (L _ patname) | eqRdrName patname var -> do
(case_pat, body) <- matches
-- TODO(sandy): use an at pattern if necessary
pure $ AgdaMatch (pats & ix i .~ case_pat) body
_ -> []
(pat, body) <- matches
-- TODO(sandy): use an at pattern if necessary
pure $ AgdaMatch (rewriteVarPat var pat pats) body
agdaSplit x = [x]


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


------------------------------------------------------------------------------
-- | Replace a 'VarPat' with the given @'Pat' GhcPs@.
rewriteVarPat :: Data a => RdrName -> Pat GhcPs -> a -> a
rewriteVarPat name rep = everywhere $ mkT $ \case
VarPat _ (L _ var) | eqRdrName name var -> rep
(x :: Pat GhcPs) -> x


------------------------------------------------------------------------------
-- | Construct an 'HsDecl' from a set of 'AgdaMatch'es.
splitToDecl
Expand Down
1 change: 1 addition & 0 deletions test/functional/Tactic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -128,6 +128,7 @@ tests = testGroup
, goldenTest "FmapJoin.hs" 2 14 Auto ""
, goldenTest "Fgmap.hs" 2 9 Auto ""
, goldenTest "FmapJoinInLet.hs" 4 19 Auto ""
, goldenTest "SplitPattern.hs" 7 25 Destruct "a"
]


Expand Down
8 changes: 8 additions & 0 deletions test/testdata/tactic/SplitPattern.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
data ADT = One | Two Int | Three | Four Bool ADT | Five

case_split :: ADT -> Int
case_split One = _
case_split (Two i) = _
case_split Three = _
case_split (Four b a) = _
case_split Five = _
12 changes: 12 additions & 0 deletions test/testdata/tactic/SplitPattern.hs.expected
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
data ADT = One | Two Int | Three | Four Bool ADT | Five

case_split :: ADT -> Int
case_split One = _
case_split (Two i) = _
case_split Three = _
case_split (Four b One) = _
case_split (Four b (Two i)) = _
case_split (Four b Three) = _
case_split (Four b (Four b2 a3)) = _
case_split (Four b Five) = _
case_split Five = _

0 comments on commit 7817a10

Please sign in to comment.