Skip to content

Commit 4c18651

Browse files
July541July541
committed
Allow import all constructors (haskell#2782)
* Import all constructors * Rewrite the test * Exact print wildcard * Rerun circleci
1 parent a3bebd5 commit 4c18651

File tree

3 files changed

+175
-18
lines changed

3 files changed

+175
-18
lines changed

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

+14-1
Original file line numberDiff line numberDiff line change
@@ -1733,6 +1733,13 @@ data ImportStyle
17331733
--
17341734
-- @P@ and @?@ can be a data type and a constructor, a class and a method,
17351735
-- a class and an associated type/data family, etc.
1736+
1737+
| ImportAllConstructors T.Text
1738+
-- ^ Import all constructors for a specific data type.
1739+
--
1740+
-- import M (P(..))
1741+
--
1742+
-- @P@ can be a data type or a class.
17361743
deriving Show
17371744

17381745
importStyles :: IdentInfo -> NonEmpty ImportStyle
@@ -1741,7 +1748,9 @@ importStyles IdentInfo {parent, rendered, isDatacon}
17411748
-- Constructors always have to be imported via their parent data type, but
17421749
-- methods and associated type/data families can also be imported as
17431750
-- top-level exports.
1744-
= ImportViaParent rendered p :| [ImportTopLevel rendered | not isDatacon]
1751+
= ImportViaParent rendered p
1752+
:| [ImportTopLevel rendered | not isDatacon]
1753+
<> [ImportAllConstructors p]
17451754
| otherwise
17461755
= ImportTopLevel rendered :| []
17471756

@@ -1750,15 +1759,19 @@ renderImportStyle :: ImportStyle -> T.Text
17501759
renderImportStyle (ImportTopLevel x) = x
17511760
renderImportStyle (ImportViaParent x p@(T.uncons -> Just ('(', _))) = "type " <> p <> "(" <> x <> ")"
17521761
renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")"
1762+
renderImportStyle (ImportAllConstructors p) = p <> "(..)"
17531763

17541764
-- | Used for extending import lists
17551765
unImportStyle :: ImportStyle -> (Maybe String, String)
17561766
unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x)
17571767
unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x)
1768+
unImportStyle (ImportAllConstructors x) = (Just $ T.unpack x, wildCardSymbol)
1769+
17581770

17591771
quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind
17601772
quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.topLevel"
17611773
quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.withParent"
1774+
quickFixImportKind' x (ImportAllConstructors _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.allConstructors"
17621775

17631776
quickFixImportKind :: T.Text -> CodeActionKind
17641777
quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x

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

+25-3
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
@@ -330,6 +332,7 @@ extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite
330332
extendImport mparent identifier lDecl@(L l _) =
331333
Rewrite (locA l) $ \df -> do
332334
case mparent of
335+
-- This will also work for `ImportAllConstructors`
333336
Just parent -> extendImportViaParent df parent identifier lDecl
334337
_ -> extendImportTopLevel identifier lDecl
335338

@@ -379,6 +382,9 @@ extendImportTopLevel thing (L l it@ImportDecl{..})
379382
#endif
380383
extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
381384

385+
wildCardSymbol :: String
386+
wildCardSymbol = ".."
387+
382388
-- | Add an identifier with its parent to import list
383389
--
384390
-- extendImportViaParent "Bar" "Cons" AST:
@@ -389,6 +395,11 @@ extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list"
389395
-- import A () --> import A (Bar(Cons))
390396
-- import A (Foo, Bar) --> import A (Foo, Bar(Cons))
391397
-- 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(..))
392403
extendImportViaParent ::
393404
DynFlags ->
394405
-- | parent (already parenthesized if needs)
@@ -423,6 +434,19 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
423434
go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs)
424435
#endif
425436
-- 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
426450
| parent == unIEWrappedName ie
427451
, hasSibling <- not $ null lies' =
428452
do
@@ -448,9 +472,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..})
448472
lies = L l' $ reverse pre ++
449473
[L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs
450474
fixLast = if hasSibling then first addComma else id
451-
return $ if hasSibling
452-
then L l it'
453-
else L l it'
475+
return $ L l it'
454476
#endif
455477
go hide l' pre (x : xs) = go hide l' (x : pre) xs
456478
go hide l' pre []

‎ghcide/test/exe/Main.hs

+136-14
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))"
@@ -1817,7 +1933,7 @@ extendImportTests = testGroup "extend import actions"
18171933
, "f = Foo 1"
18181934
])
18191935
(Range (Position 3 4) (Position 3 6))
1820-
["Add Foo(Foo) to the import list of ModuleA"]
1936+
["Add Foo(Foo) to the import list of ModuleA", "Add Foo(..) to the import list of ModuleA"]
18211937
(T.unlines
18221938
[ "module ModuleB where"
18231939
, "import ModuleA(Foo (Foo))"
@@ -1997,11 +2113,14 @@ suggestImportTests = testGroup "suggest import actions"
19972113
, test False [] "f ExitSuccess = ()" [] "import System.Exit (ExitSuccess)"
19982114
-- don't suggest data constructor when we only need the type
19992115
, test False [] "f :: Bar" [] "import Bar (Bar(Bar))"
2116+
-- don't suggest all data constructors for the data type
2117+
, test False [] "f :: Bar" [] "import Bar (Bar(..))"
20002118
]
20012119
, testGroup "want suggestion"
20022120
[ wantWait [] "f = foo" [] "import Foo (foo)"
20032121
, wantWait [] "f = Bar" [] "import Bar (Bar(Bar))"
20042122
, wantWait [] "f :: Bar" [] "import Bar (Bar)"
2123+
, wantWait [] "f = Bar" [] "import Bar (Bar(..))"
20052124
, test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
20062125
, test True [] "f = (:|)" [] "import Data.List.NonEmpty (NonEmpty((:|)))"
20072126
, test True [] "f :: Natural" ["f = undefined"] "import Numeric.Natural (Natural)"
@@ -2043,12 +2162,15 @@ suggestImportTests = testGroup "suggest import actions"
20432162
, "qualified Data.Functor as T"
20442163
, "qualified Data.Data as T"
20452164
] "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(..))"
20462167
]
2047-
, expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)"
2168+
, expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)"
20482169
]
20492170
where
20502171
test = test' False
20512172
wantWait = test' True True
2173+
20522174
test' waitForCheckProject wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do
20532175
configureCheckProject waitForCheckProject
20542176
let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
@@ -2058,7 +2180,7 @@ suggestImportTests = testGroup "suggest import actions"
20582180
liftIO $ writeFileUTF8 (dir </> "B.hs") $ unlines ["{-# LANGUAGE PatternSynonyms #-}", "module B where", "pattern Some x = Just x"]
20592181
doc <- createDoc "Test.hs" "haskell" before
20602182
waitForProgressDone
2061-
_diags <- waitForDiagnostics
2183+
_ <- waitForDiagnostics
20622184
-- there isn't a good way to wait until the whole project is checked atm
20632185
when waitForCheckProject $ liftIO $ sleep 0.5
20642186
let defLine = fromIntegral $ length imps + 1

0 commit comments

Comments
 (0)