Skip to content

Commit 63c14de

Browse files
July541July541
committed
Exact print wildcard
1 parent 0a83296 commit 63c14de

File tree

3 files changed

+156
-17
lines changed

3 files changed

+156
-17
lines changed

‎ghcide/src/Development/IDE/Plugin/CodeAction.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1739,7 +1739,7 @@ data ImportStyle
17391739
--
17401740
-- import M (P(..))
17411741
--
1742-
-- @P@ __must__ be a data type.
1742+
-- @P@ can be a data type or a class.
17431743
deriving Show
17441744

17451745
importStyles :: IdentInfo -> NonEmpty ImportStyle
@@ -1750,7 +1750,7 @@ importStyles IdentInfo {parent, rendered, isDatacon}
17501750
-- top-level exports.
17511751
= ImportViaParent rendered p
17521752
:| [ImportTopLevel rendered | not isDatacon]
1753-
<> [ImportAllConstructors p | isDatacon]
1753+
<> [ImportAllConstructors p]
17541754
| otherwise
17551755
= ImportTopLevel rendered :| []
17561756

@@ -1765,7 +1765,7 @@ renderImportStyle (ImportAllConstructors p) = p <> "(..)"
17651765
unImportStyle :: ImportStyle -> (Maybe String, String)
17661766
unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x)
17671767
unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x)
1768-
unImportStyle (ImportAllConstructors x) = (Just $ T.unpack x, "..")
1768+
unImportStyle (ImportAllConstructors x) = (Just $ T.unpack x, wildCardSymbol)
17691769

17701770

17711771
quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind

‎ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs‎

Lines changed: 24 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@ module Development.IDE.Plugin.CodeAction.ExactPrint (
1919
extendImport,
2020
hideSymbol,
2121
liftParseAST,
22+
23+
wildCardSymbol
2224
) where
2325

2426
import Control.Applicative
@@ -380,6 +382,9 @@ extendImportTopLevel thing (L l it@ImportDecl{..})
380382
#endif
381383
extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
382384

385+
wildCardSymbol :: String
386+
wildCardSymbol = ".."
387+
383388
-- | Add an identifier with its parent to import list
384389
--
385390
-- extendImportViaParent "Bar" "Cons" AST:
@@ -390,6 +395,11 @@ extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
390395
-- import A () --> import A (Bar(Cons))
391396
-- import A (Foo, Bar) --> import A (Foo, Bar(Cons))
392397
-- import A (Foo, Bar()) --> import A (Foo, Bar(Cons))
398+
--
399+
-- extendImportViaParent "Bar" ".." AST:
400+
-- import A () --> import A (Bar(..))
401+
-- import A (Foo, Bar) -> import A (Foo, Bar(..))
402+
-- import A (Foo, Bar()) -> import A (Foo, Bar(..))
393403
extendImportViaParent ::
394404
DynFlags ->
395405
-- | parent (already parenthesized if needs)
@@ -424,6 +434,19 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
424434
go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs)
425435
#endif
426436
-- ThingWith ie lies' => ThingWith ie (lies' ++ [child])
437+
| parent == unIEWrappedName ie
438+
, child == wildCardSymbol = do
439+
#if MIN_VERSION_ghc(9,2,0)
440+
let it' = it{ideclHiding = Just (hide, lies)}
441+
thing = IEThingWith newl twIE (IEWildcard 2) []
442+
newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l'''
443+
lies = L l' $ reverse pre ++ [L l'' thing] ++ xs
444+
return $ L l it'
445+
#else
446+
let thing = L l'' (IEThingWith noExtField twIE (IEWildcard 2) [] [])
447+
modifyAnnsT (Map.map (\ann -> ann{annsDP = (G AnnDotdot, dp00) : annsDP ann}))
448+
return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [thing] ++ xs)}
449+
#endif
427450
| parent == unIEWrappedName ie
428451
, hasSibling <- not $ null lies' =
429452
do
@@ -449,9 +472,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
449472
lies = L l' $ reverse pre ++
450473
[L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs
451474
fixLast = if hasSibling then first addComma else id
452-
return $ if hasSibling
453-
then L l it'
454-
else L l it'
475+
return $ L l it'
455476
#endif
456477
go hide l' pre (x : xs) = go hide l' (x : pre) xs
457478
go hide l' pre []

‎ghcide/test/exe/Main.hs‎

Lines changed: 129 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1513,7 +1513,108 @@ extendImportTests = testGroup "extend import actions"
15131513
]
15141514
where
15151515
tests overrideCheckProject =
1516-
[ testSession "extend single line import with value" $ template
1516+
[ testSession "extend all constructors for record field" $ template
1517+
[("ModuleA.hs", T.unlines
1518+
[ "module ModuleA where"
1519+
, "data A = B { a :: Int }"
1520+
])]
1521+
("ModuleB.hs", T.unlines
1522+
[ "module ModuleB where"
1523+
, "import ModuleA (A(B))"
1524+
, "f = a"
1525+
])
1526+
(Range (Position 2 4) (Position 2 5))
1527+
[ "Add A(..) to the import list of ModuleA"
1528+
, "Add A(a) to the import list of ModuleA"
1529+
, "Add a to the import list of ModuleA"
1530+
]
1531+
(T.unlines
1532+
[ "module ModuleB where"
1533+
, "import ModuleA (A(..))"
1534+
, "f = a"
1535+
])
1536+
, testSession "extend all constructors with sibling" $ template
1537+
[("ModuleA.hs", T.unlines
1538+
[ "module ModuleA where"
1539+
, "data Foo"
1540+
, "data Bar"
1541+
, "data A = B | C"
1542+
])]
1543+
("ModuleB.hs", T.unlines
1544+
[ "module ModuleB where"
1545+
, "import ModuleA ( Foo, A (C) , Bar ) "
1546+
, "f = B"
1547+
])
1548+
(Range (Position 2 4) (Position 2 5))
1549+
[ "Add A(..) to the import list of ModuleA"
1550+
, "Add A(B) to the import list of ModuleA"
1551+
]
1552+
(T.unlines
1553+
[ "module ModuleB where"
1554+
, "import ModuleA ( Foo, A (..) , Bar ) "
1555+
, "f = B"
1556+
])
1557+
, testSession "extend all constructors with comment" $ template
1558+
[("ModuleA.hs", T.unlines
1559+
[ "module ModuleA where"
1560+
, "data Foo"
1561+
, "data Bar"
1562+
, "data A = B | C"
1563+
])]
1564+
("ModuleB.hs", T.unlines
1565+
[ "module ModuleB where"
1566+
, "import ModuleA ( Foo, A (C{-comment--}) , Bar ) "
1567+
, "f = B"
1568+
])
1569+
(Range (Position 2 4) (Position 2 5))
1570+
[ "Add A(..) to the import list of ModuleA"
1571+
, "Add A(B) to the import list of ModuleA"
1572+
]
1573+
(T.unlines
1574+
[ "module ModuleB where"
1575+
, "import ModuleA ( Foo, A (..{-comment--}) , Bar ) "
1576+
, "f = B"
1577+
])
1578+
, testSession "extend all constructors for type operator" $ template
1579+
[]
1580+
("ModuleA.hs", T.unlines
1581+
[ "module ModuleA where"
1582+
, "import Data.Type.Equality ((:~:))"
1583+
, "x :: (:~:) [] []"
1584+
, "x = Refl"
1585+
])
1586+
(Range (Position 3 17) (Position 3 18))
1587+
[ "Add (:~:)(..) to the import list of Data.Type.Equality"
1588+
, "Add type (:~:)(Refl) to the import list of Data.Type.Equality"]
1589+
(T.unlines
1590+
[ "module ModuleA where"
1591+
, "import Data.Type.Equality ((:~:) (..))"
1592+
, "x :: (:~:) [] []"
1593+
, "x = Refl"
1594+
])
1595+
, testSession "extend all constructors for class" $ template
1596+
[("ModuleA.hs", T.unlines
1597+
[ "module ModuleA where"
1598+
, "class C a where"
1599+
, " m1 :: a -> a"
1600+
, " m2 :: a -> a"
1601+
])]
1602+
("ModuleB.hs", T.unlines
1603+
[ "module ModuleB where"
1604+
, "import ModuleA (C(m1))"
1605+
, "b = m2"
1606+
])
1607+
(Range (Position 2 5) (Position 2 5))
1608+
[ "Add C(..) to the import list of ModuleA"
1609+
, "Add C(m2) to the import list of ModuleA"
1610+
, "Add m2 to the import list of ModuleA"
1611+
]
1612+
(T.unlines
1613+
[ "module ModuleB where"
1614+
, "import ModuleA (C(..))"
1615+
, "b = m2"
1616+
])
1617+
, testSession "extend single line import with value" $ template
15171618
[("ModuleA.hs", T.unlines
15181619
[ "module ModuleA where"
15191620
, "stuffA :: Double"
@@ -1561,7 +1662,9 @@ extendImportTests = testGroup "extend import actions"
15611662
, "main = case (fromList []) of _ :| _ -> pure ()"
15621663
])
15631664
(Range (Position 2 5) (Position 2 6))
1564-
["Add NonEmpty((:|)) to the import list of Data.List.NonEmpty"]
1665+
[ "Add NonEmpty((:|)) to the import list of Data.List.NonEmpty"
1666+
, "Add NonEmpty(..) to the import list of Data.List.NonEmpty"
1667+
]
15651668
(T.unlines
15661669
[ "module ModuleB where"
15671670
, "import Data.List.NonEmpty (fromList, NonEmpty ((:|)))"
@@ -1576,7 +1679,9 @@ extendImportTests = testGroup "extend import actions"
15761679
, "x = Just 10"
15771680
])
15781681
(Range (Position 3 5) (Position 2 6))
1579-
["Add Maybe(Just) to the import list of Data.Maybe"]
1682+
[ "Add Maybe(Just) to the import list of Data.Maybe"
1683+
, "Add Maybe(..) to the import list of Data.Maybe"
1684+
]
15801685
(T.unlines
15811686
[ "module ModuleB where"
15821687
, "import Prelude hiding (Maybe(..))"
@@ -1614,7 +1719,9 @@ extendImportTests = testGroup "extend import actions"
16141719
, "b = Constructor"
16151720
])
16161721
(Range (Position 3 5) (Position 3 5))
1617-
["Add A(Constructor) to the import list of ModuleA"]
1722+
[ "Add A(Constructor) to the import list of ModuleA"
1723+
, "Add A(..) to the import list of ModuleA"
1724+
]
16181725
(T.unlines
16191726
[ "module ModuleB where"
16201727
, "import ModuleA (A (Constructor))"
@@ -1633,7 +1740,9 @@ extendImportTests = testGroup "extend import actions"
16331740
, "b = Constructor"
16341741
])
16351742
(Range (Position 3 5) (Position 3 5))
1636-
["Add A(Constructor) to the import list of ModuleA"]
1743+
[ "Add A(Constructor) to the import list of ModuleA"
1744+
, "Add A(..) to the import list of ModuleA"
1745+
]
16371746
(T.unlines
16381747
[ "module ModuleB where"
16391748
, "import ModuleA (A (Constructor{-Constructor-}))"
@@ -1653,7 +1762,9 @@ extendImportTests = testGroup "extend import actions"
16531762
, "b = ConstructorFoo"
16541763
])
16551764
(Range (Position 3 5) (Position 3 5))
1656-
["Add A(ConstructorFoo) to the import list of ModuleA"]
1765+
[ "Add A(ConstructorFoo) to the import list of ModuleA"
1766+
, "Add A(..) to the import list of ModuleA"
1767+
]
16571768
(T.unlines
16581769
[ "module ModuleB where"
16591770
, "import ModuleA (A (ConstructorBar, ConstructorFoo), a)"
@@ -1715,8 +1826,10 @@ extendImportTests = testGroup "extend import actions"
17151826
, "b = m2"
17161827
])
17171828
(Range (Position 2 5) (Position 2 5))
1718-
["Add C(m2) to the import list of ModuleA",
1719-
"Add m2 to the import list of ModuleA"]
1829+
[ "Add C(m2) to the import list of ModuleA"
1830+
, "Add m2 to the import list of ModuleA"
1831+
, "Add C(..) to the import list of ModuleA"
1832+
]
17201833
(T.unlines
17211834
[ "module ModuleB where"
17221835
, "import ModuleA (C(m1, m2))"
@@ -1735,8 +1848,10 @@ extendImportTests = testGroup "extend import actions"
17351848
, "b = m2"
17361849
])
17371850
(Range (Position 2 5) (Position 2 5))
1738-
["Add m2 to the import list of ModuleA",
1739-
"Add C(m2) to the import list of ModuleA"]
1851+
[ "Add m2 to the import list of ModuleA"
1852+
, "Add C(m2) to the import list of ModuleA"
1853+
, "Add C(..) to the import list of ModuleA"
1854+
]
17401855
(T.unlines
17411856
[ "module ModuleB where"
17421857
, "import ModuleA (C(m1), m2)"
@@ -1777,7 +1892,8 @@ extendImportTests = testGroup "extend import actions"
17771892
, "x = Refl"
17781893
])
17791894
(Range (Position 3 17) (Position 3 18))
1780-
["Add type (:~:)(Refl) to the import list of Data.Type.Equality"]
1895+
[ "Add type (:~:)(Refl) to the import list of Data.Type.Equality"
1896+
, "Add (:~:)(..) to the import list of Data.Type.Equality"]
17811897
(T.unlines
17821898
[ "module ModuleA where"
17831899
, "import Data.Type.Equality ((:~:) (Refl))"
@@ -2046,6 +2162,8 @@ suggestImportTests = testGroup "suggest import actions"
20462162
, "qualified Data.Functor as T"
20472163
, "qualified Data.Data as T"
20482164
] "f = T.putStrLn" [] "import qualified Data.Text.IO as T"
2165+
, test True [] "f = (.|.)" [] "import Data.Bits (Bits(..))"
2166+
, test True [] "f = empty" [] "import Control.Applicative (Alternative(..))"
20492167
]
20502168
, expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)"
20512169
]

0 commit comments

Comments
 (0)