on master help sign in
Guess all imports (#459)

* Suggest missing imports via package exports map At the expense of some space and initialization time, suggest imports now is able to find suggestions in all the packages available to the project. * BadDependency - include the key in the error message * remove the assumption that the GhcSession is always available * fix bad spacing Co-Authored-By: Moritz Kiefer <moritz.kiefer@purelyfunctional.org> * Add type annotation to clarify rule being defined * Remove file dependency from PackageExports rule * Guess patterns Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>

commitda92de218a5d8f3b5f2c1f36726e5d079e6dcb79 authorPepe Iborra <pepeiborra@gmail.com> dateMon 9 Mar 2020, 13:22 (7 years ago) parentbd25cd0
8 files changed+220−84
ghcide.cabal+2 src/Development/IDE/Core/Shake.hs+4−4 src/Development/IDE/GHC/Util.hs+21 src/Development/IDE/Plugin.hs+5−2 src/Development/IDE/Plugin/CodeAction.hs+47−66 src/Development/IDE/Plugin/CodeAction/RuleTypes.hs+61 src/Development/IDE/Plugin/CodeAction/Rules.hs+61 test/exe/Main.hs+19−12
ghcide.cabal+2
@@ -139,6 +139,8 @@ library
139139 Development.IDE.Spans.Documentation
140140 Development.IDE.Spans.Type
141141 Development.IDE.Plugin.CodeAction.PositionIndexed
142+ Development.IDE.Plugin.CodeAction.Rules
143+ Development.IDE.Plugin.CodeAction.RuleTypes
142144 Development.IDE.Plugin.Completions.Logic
143145 Development.IDE.Plugin.Completions.Types
144146 ghc-options: -Wall -Wno-name-shadowing
src/Development/IDE/Core/Shake.hs+4−4
@@ -488,13 +488,13 @@ uses_ :: IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
488488uses_ key files = do
489489 res <- uses key files
490490 case sequence res of
491− Nothing -> liftIO $ throwIO BadDependency
491+ Nothing -> liftIO $ throwIO $ BadDependency (show key)
492492 Just v -> return v
493493
494494
495495-- | When we depend on something that reported an error, and we fail as a direct result, throw BadDependency
496496-- which short-circuits the rest of the action
497−data BadDependency = BadDependency deriving Show
497+data BadDependency = BadDependency String deriving Show
498498instance Exception BadDependency
499499
500500isBadDependency :: SomeException -> Bool
@@ -659,12 +659,12 @@ defineOnDisk act = addBuiltinRule noLint noIdentity $
659659needOnDisk :: (Shake.ShakeValue k, RuleResult k ~ ()) => k -> NormalizedFilePath -> Action ()
660660needOnDisk k file = do
661661 successfull <- apply1 (QDisk k file)
662− liftIO $ unless successfull $ throwIO BadDependency
662+ liftIO $ unless successfull $ throwIO $ BadDependency (show k)
663663
664664needOnDisks :: (Shake.ShakeValue k, RuleResult k ~ ()) => k -> [NormalizedFilePath] -> Action ()
665665needOnDisks k files = do
666666 successfulls <- apply $ map (QDisk k) files
667− liftIO $ unless (and successfulls) $ throwIO BadDependency
667+ liftIO $ unless (and successfulls) $ throwIO $ BadDependency (show k)
668668
669669toShakeValue :: (BS.ByteString -> ShakeValue) -> Maybe BS.ByteString -> ShakeValue
670670toShakeValue = maybe ShakeNoCutoff
src/Development/IDE/GHC/Util.hs+21
@@ -9,6 +9,8 @@ module Development.IDE.GHC.Util(
99 runGhcEnv,
1010 -- * GHC wrappers
1111 prettyPrint,
12+ printRdrName,
13+ printName,
1214 ParseResult(..), runParser,
1315 lookupPackageConfig,
1416 moduleImportPath,
@@ -98,6 +100,16 @@ runParser flags str parser = unP parser parseState
98100prettyPrint :: Outputable a => a -> String
99101prettyPrint = showSDoc unsafeGlobalDynFlags . ppr
100102
103+-- | Pretty print a 'RdrName' wrapping operators in parens
104+printRdrName :: RdrName -> String
105+printRdrName name = showSDocUnsafe $ parenSymOcc rn (ppr rn)
106+ where
107+ rn = rdrNameOcc name
108+
109+-- | Pretty print a 'Name' wrapping operators in parens
110+printName :: Name -> String
111+printName = printRdrName . nameRdrName
112+
101113-- | Run a 'Ghc' monad value using an existing 'HscEnv'. Sets up and tears down all the required
102114-- pieces, but designed to be more efficient than a standard 'runGhc'.
103115runGhcEnv :: HscEnv -> Ghc a -> IO a
@@ -151,6 +163,15 @@ instance Eq HscEnvEq where
151163instance NFData HscEnvEq where
152164 rnf (HscEnvEq a b) = rnf (hashUnique a) `seq` b `seq` ()
153165
166+instance Hashable HscEnvEq where
167+ hashWithSalt salt (HscEnvEq u _) = hashWithSalt salt u
168+
169+-- Fake instance needed to persuade Shake to accept this type as a key.
170+-- No harm done as ghcide never persists these keys currently
171+instance Binary HscEnvEq where
172+ put _ = error "not really"
173+ get = error "not really"
174+
154175-- | Read a UTF8 file, with lenient decoding, so it will never raise a decoding error.
155176readFileUtf8 :: FilePath -> IO T.Text
156177readFileUtf8 f = T.decodeUtf8With T.lenientDecode <$> BS.readFile f
src/Development/IDE/Plugin.hs+5−2
@@ -1,5 +1,5 @@
11
2−module Development.IDE.Plugin(Plugin(..), codeActionPlugin) where
2+module Development.IDE.Plugin(Plugin(..), codeActionPlugin, codeActionPluginWithRules) where
33
44import Data.Default
55import Development.Shake
@@ -27,7 +27,10 @@ instance Monoid (Plugin c) where
2727
2828
2929codeActionPlugin :: (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
30−codeActionPlugin f = Plugin mempty $ PartialHandlers $ \WithMessage{..} x -> return x{
30+codeActionPlugin = codeActionPluginWithRules mempty
31+
32+codeActionPluginWithRules :: Rules () -> (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
33+codeActionPluginWithRules rr f = Plugin rr $ PartialHandlers $ \WithMessage{..} x -> return x{
3134 LSP.codeActionHandler = withResponse RspCodeAction g
3235 }
3336 where
src/Development/IDE/Plugin/CodeAction.hs+47−66
@@ -8,7 +8,6 @@
88-- | Go to the definition of a variable.
99module Development.IDE.Plugin.CodeAction(plugin) where
1010
11−import Avail (AvailInfo(Avail), AvailInfo(AvailTC), availNames)
1211import Language.Haskell.LSP.Types
1312import Control.Monad (join)
1413import Development.IDE.Plugin
@@ -21,8 +20,11 @@ import Development.IDE.GHC.Error
2120import Development.IDE.GHC.Util
2221import Development.IDE.LSP.Server
2322import Development.IDE.Plugin.CodeAction.PositionIndexed
23+import Development.IDE.Plugin.CodeAction.RuleTypes
24+import Development.IDE.Plugin.CodeAction.Rules
2425import Development.IDE.Types.Location
2526import Development.IDE.Types.Options
27+import Development.Shake (Rules)
2628import qualified Data.HashMap.Strict as Map
2729import qualified Language.Haskell.LSP.Core as LSP
2830import Language.Haskell.LSP.VFS
@@ -36,20 +38,18 @@ import Data.List.Extra
3638import qualified Data.Text as T
3739import Data.Tuple.Extra ((&&&))
3840import HscTypes
39−import OccName
4041import Parser
41−import RdrName
4242import Text.Regex.TDFA ((=~), (=~~))
4343import Text.Regex.TDFA.Text()
4444import Outputable (ppr, showSDocUnsafe)
4545import DynFlags (xFlags, FlagSpec(..))
4646import GHC.LanguageExtensions.Type (Extension)
47−import Data.IORef (readIORef)
48−import Name (isDataConName, nameModule_maybe, nameOccName)
49−import Packages (exposedModules, lookupPackage)
5047
5148plugin :: Plugin c
52−plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens
49+plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
50+
51+rules :: Rules ()
52+rules = rulePackageExports
5353
5454-- | Generate code actions.
5555codeAction
@@ -65,15 +65,15 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
6565 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
6666 let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
6767 mbFile = toNormalizedFilePath <$> uriToFilePath uri
68− (ideOptions, parsedModule, env) <- runAction state $
68+ (ideOptions, parsedModule, join -> env) <- runAction state $
6969 (,,) <$> getIdeOptions
70− <*> getParsedModule `traverse` mbFile
71− <*> use_ GhcSession `traverse` mbFile
70+ <*> getParsedModule `traverse` mbFile
71+ <*> use GhcSession `traverse` mbFile
72+ pkgExports <- runAction state $ (useNoFile_ . PackageExports) `traverse` env
7273 let dflags = hsc_dflags . hscEnv <$> env
73− eps <- traverse readIORef (hsc_EPS . hscEnv <$> env)
7474 pure $ Right
7575 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
76− | x <- xs, (title, tedit) <- suggestAction dflags eps ideOptions ( join parsedModule ) text x
76+ | x <- xs, (title, tedit) <- suggestAction dflags (fromMaybe mempty pkgExports) ideOptions ( join parsedModule ) text x
7777 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
7878 ]
7979
@@ -114,13 +114,13 @@ executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
114114
115115suggestAction
116116 :: Maybe DynFlags
117− -> Maybe ExternalPackageState
117+ -> PackageExportsMap
118118 -> IdeOptions
119119 -> Maybe ParsedModule
120120 -> Maybe T.Text
121121 -> Diagnostic
122122 -> [(T.Text, [TextEdit])]
123−suggestAction dflags eps ideOptions parsedModule text diag = concat
123+suggestAction dflags packageExports ideOptions parsedModule text diag = concat
124124 [ suggestAddExtension diag
125125 , suggestExtendImport dflags text diag
126126 , suggestFillHole diag
@@ -132,7 +132,7 @@ suggestAction dflags eps ideOptions parsedModule text diag = concat
132132 ] ++ concat
133133 [ suggestNewDefinition ideOptions pm text diag
134134 ++ suggestRemoveRedundantImport pm text diag
135− ++ concat [suggestNewImport dflags eps pm diag | Just eps <- [eps], Just dflags <- [dflags]]
135+ ++ suggestNewImport packageExports pm diag
136136 | Just pm <- [parsedModule]]
137137
138138
@@ -304,15 +304,10 @@ suggestExtendImport (Just dflags) contents Diagnostic{_range=_range,..}
304304 _ -> error "bug in srcspan parser"
305305 importLine = textInRange range c
306306 in [("Add " <> binding <> " to the import list of " <> mod
307− , [TextEdit range (addBindingToImportList (printRdrName name) importLine)])]
307+ , [TextEdit range (addBindingToImportList (T.pack $ printRdrName name) importLine)])]
308308 | otherwise = []
309309suggestExtendImport Nothing _ _ = []
310310
311−printRdrName :: RdrName -> T.Text
312−printRdrName name = T.pack $ showSDocUnsafe $ parenSymOcc rn (ppr rn)
313− where
314− rn = rdrNameOcc name
315−
316311suggestFixConstructorImport :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
317312suggestFixConstructorImport _ Diagnostic{_range=_range,..}
318313 -- ‘Success’ is a data constructor of ‘Result’
@@ -353,8 +348,8 @@ suggestSignature _ _ = []
353348
354349-------------------------------------------------------------------------------------------------
355350
356−suggestNewImport :: DynFlags -> ExternalPackageState -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
357−suggestNewImport dflags eps ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
351+suggestNewImport :: PackageExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
352+suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message}
358353 | msg <- unifySpaces _message
359354 , Just name <- extractNotInScopeName msg
360355 , Just insertLine <- case hsmodImports of
@@ -365,52 +360,36 @@ suggestNewImport dflags eps ParsedModule {pm_parsed_source = L _ HsModule {..}}
365360 RealSrcLoc s -> Just $ srcLocLine s
366361 _ -> Nothing
367362 , insertPos <- Position insertLine 0
368− , extendImportSuggestions <- -- Just [binding, mod, srcspan] <-
369− matchRegex msg
363+ , extendImportSuggestions <- matchRegex msg
370364 "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’"
371365 = [(imp, [TextEdit (Range insertPos insertPos) (imp <> "\n")])
372− | imp <- constructNewImportSuggestions dflags eps name extendImportSuggestions
366+ | imp <- constructNewImportSuggestions packageExportsMap name extendImportSuggestions
373367 ]
374−suggestNewImport _ _ _ _ = []
375−
376−constructNewImportSuggestions :: DynFlags -> ExternalPackageState -> NotInScope -> Maybe [T.Text] -> [T.Text]
377−constructNewImportSuggestions dflags eps thingMissing notTheseModules = nubOrd
378− [ case qual of
379− Nothing -> "import " <> modName <> " (" <> importWhat candidate avail <> ")"
380− Just q -> "import qualified " <> modName <> " as " <> q
381− | item <- items,
382− avail <- tyThingAvailInfo item,
383− canUseAvail thingMissing avail,
384− candidate <- availNames avail,
385− canUseName thingMissing candidate,
386− occNameString (nameOccName candidate) == T.unpack name,
387− Just m <- [nameModule_maybe candidate],
388− Just package <- [lookupPackage dflags (moduleUnitId m)],
389− moduleName m `elem` map fst (exposedModules package),
390− let modName = T.pack $ moduleNameString $ moduleName m,
391− modName `notElem` fromMaybe [] notTheseModules
392− ]
393− where
394− (qual, name) = case T.splitOn "." (notInScope thingMissing) of
395− [n] -> (Nothing, n)
396− segments -> (Just (T.concat $ init segments), last segments)
397− items = typeEnvElts $ eps_PTE eps
398− importWhat this (AvailTC parent _ _)
399− -- "Maybe(Just)"
400− | this /= parent
401− = T.pack (occNameString (nameOccName parent)) <>
402− "(" <> printName this <> ")"
403− importWhat this _ = printName this
404−
405− printName = printRdrName . nameRdrName
406−
407−canUseAvail :: NotInScope -> AvailInfo -> Bool
408−canUseAvail NotInScopeDataConstructor{} Avail{} = False
409−canUseAvail _ _ = True
410−
411−canUseName :: NotInScope -> Name -> Bool
412−canUseName NotInScopeDataConstructor{} = isDataConName
413−canUseName _ = const True
368+suggestNewImport _ _ _ = []
369+
370+constructNewImportSuggestions
371+ :: PackageExportsMap -> NotInScope -> Maybe [T.Text] -> [T.Text]
372+constructNewImportSuggestions exportsMap thingMissing notTheseModules = nubOrd
373+ [ renderNewImport identInfo m
374+ | (identInfo, m) <- fromMaybe [] $ Map.lookup name exportsMap
375+ , canUseIdent thingMissing identInfo
376+ , m `notElem` fromMaybe [] notTheseModules
377+ ]
378+ where
379+ renderNewImport identInfo m
380+ | Just q <- qual = "import qualified " <> m <> " as " <> q
381+ | otherwise = "import " <> m <> " (" <> importWhat identInfo <> ")"
382+
383+ (qual, name) = case T.splitOn "." (notInScope thingMissing) of
384+ [n] -> (Nothing, n)
385+ segments -> (Just (T.concat $ init segments), last segments)
386+ importWhat IdentInfo {parent, rendered}
387+ | Just p <- parent = p <> "(" <> rendered <> ")"
388+ | otherwise = rendered
389+
390+canUseIdent :: NotInScope -> IdentInfo -> Bool
391+canUseIdent NotInScopeDataConstructor{} = isDatacon
392+canUseIdent _ = const True
414393
415394data NotInScope
416395 = NotInScopeDataConstructor T.Text
@@ -427,6 +406,8 @@ extractNotInScopeName :: T.Text -> Maybe NotInScope
427406extractNotInScopeName x
428407 | Just [name] <- matchRegex x "Data constructor not in scope: ([^ ]+)"
429408 = Just $ NotInScopeDataConstructor name
409+ | Just [name] <- matchRegex x "Not in scope: data constructor [^‘]*‘([^’]*)’"
410+ = Just $ NotInScopeDataConstructor name
430411 | Just [name] <- matchRegex x "ot in scope: type constructor or class [^‘]*‘([^’]*)’"
431412 = Just $ NotInScopeTypeConstructorOrClass name
432413 | Just [name] <- matchRegex x "ot in scope: ([^‘ ]+)"
src/Development/IDE/Plugin/CodeAction/RuleTypes.hsnew file+61
@@ -0,0 +1,61 @@
1+{-# LANGUAGE TypeFamilies #-}
2+module Development.IDE.Plugin.CodeAction.RuleTypes
3+ (PackageExports(..), PackageExportsMap
4+ ,IdentInfo(..)
5+ ,mkIdentInfos
6+ ) where
7+
8+import Avail (AvailInfo(..))
9+import Data.Hashable (Hashable)
10+import Control.DeepSeq (NFData)
11+import Data.Binary (Binary)
12+import Data.Text (pack, Text)
13+import Development.IDE.GHC.Util
14+import Development.Shake (RuleResult)
15+import Data.HashMap.Strict (HashMap)
16+import Data.Typeable (Typeable)
17+import GHC.Generics (Generic)
18+import Name
19+import FieldLabel (flSelector)
20+
21+type Identifier = Text
22+type ModuleName = Text
23+
24+data IdentInfo = IdentInfo
25+ { name :: !Identifier
26+ , rendered :: Text
27+ , parent :: !(Maybe Text)
28+ , isDatacon :: !Bool
29+ }
30+ deriving (Eq, Generic, Show)
31+
32+instance NFData IdentInfo
33+
34+mkIdentInfos :: AvailInfo -> [IdentInfo]
35+mkIdentInfos (Avail n) =
36+ [IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n)]
37+mkIdentInfos (AvailTC parent (n:nn) flds)
38+ -- Following the GHC convention that parent == n if parent is exported
39+ | n == parent
40+ = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) True
41+ | n <- nn ++ map flSelector flds
42+ ] ++
43+ [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing False]
44+ where
45+ parentP = pack $ prettyPrint parent
46+
47+mkIdentInfos (AvailTC _ nn flds)
48+ = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing True
49+ | n <- nn ++ map flSelector flds
50+ ]
51+
52+-- Rule type for caching Package Exports
53+type instance RuleResult PackageExports = PackageExportsMap
54+type PackageExportsMap = HashMap Identifier [(IdentInfo,ModuleName)]
55+
56+newtype PackageExports = PackageExports HscEnvEq
57+ deriving (Eq, Show, Typeable, Generic)
58+
59+instance Hashable PackageExports
60+instance NFData PackageExports
61+instance Binary PackageExports
src/Development/IDE/Plugin/CodeAction/Rules.hsnew file+61
@@ -0,0 +1,61 @@
1+module Development.IDE.Plugin.CodeAction.Rules
2+ ( rulePackageExports
3+ )
4+where
5+
6+import Data.HashMap.Strict ( fromListWith )
7+import Data.Text ( Text
8+ , pack
9+ )
10+import Data.Traversable ( forM )
11+import Development.IDE.Core.Rules
12+import Development.IDE.GHC.Util
13+import Development.IDE.Plugin.CodeAction.RuleTypes
14+import Development.Shake
15+import GHC ( DynFlags(pkgState) )
16+import HscTypes ( IfaceExport
17+ , hsc_dflags
18+ , mi_exports
19+ )
20+import LoadIface
21+import Maybes
22+import Module ( Module(..)
23+ , ModuleName
24+ , moduleNameString
25+ )
26+import Packages ( explicitPackages
27+ , exposedModules
28+ , packageConfigId
29+ )
30+import TcRnMonad ( WhereFrom(ImportByUser)
31+ , initIfaceLoad
32+ )
33+
34+rulePackageExports :: Rules ()
35+rulePackageExports = defineNoFile $ \(PackageExports session) -> do
36+ let env = hscEnv session
37+ pkgst = pkgState (hsc_dflags env)
38+ depends = explicitPackages pkgst
39+ targets =
40+ [ (pkg, mn)
41+ | d <- depends
42+ , Just pkg <- [lookupPackageConfig d env]
43+ , (mn, _) <- exposedModules pkg
44+ ]
45+
46+ results <- forM targets $ \(pkg, mn) -> do
47+ modIface <- liftIO $ initIfaceLoad env $ loadInterface
48+ ""
49+ (Module (packageConfigId pkg) mn)
50+ (ImportByUser False)
51+ case modIface of
52+ Failed _err -> return mempty
53+ Succeeded mi -> do
54+ let avails = mi_exports mi
55+ return $ concatMap (unpackAvail mn) avails
56+ return $ fromListWith (++) $ concat results
57+
58+unpackAvail :: ModuleName -> IfaceExport -> [(Text, [(IdentInfo, Text)])]
59+unpackAvail mod =
60+ map (\id@IdentInfo {..} -> (name, [(id, pack $ moduleNameString mod)]))
61+ . mkIdentInfos
test/exe/Main.hs+19−12
@@ -901,34 +901,41 @@ suggestImportTests :: TestTree
901901suggestImportTests = testGroup "suggest import actions"
902902 [ testGroup "Dont want suggestion"
903903 [ -- extend import
904− test False ["Data.List.NonEmpty ()"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
904+ test False ["Data.List.NonEmpty ()"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
905905 -- data constructor
906− , test False [] "f = First" [] "import Data.Monoid (First)"
906+ , test False [] "f = First" [] "import Data.Monoid (First)"
907907 -- internal module
908908 , test False [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable.Internal (Typeable)"
909+ -- package not in scope
910+ , test False [] "f = quickCheck" [] "import Test.QuickCheck (quickCheck)"
909911 ]
910912 , testGroup "want suggestion"
911913 [ test True [] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
912− , test True [] "f = (:|)" [] "import GHC.Base (NonEmpty((:|)))"
913− , test True [] "f :: Natural" ["f = undefined"] "import GHC.Natural (Natural)"
914− , test True [] "f :: NonEmpty ()" ["f = () :| []"] "import GHC.Base (NonEmpty)"
914+ , test True [] "f = (:|)" [] "import Data.List.NonEmpty (NonEmpty((:|)))"
915+ , test True [] "f :: Natural" ["f = undefined"] "import Numeric.Natural (Natural)"
916+ , test True [] "f :: NonEmpty ()" ["f = () :| []"] "import Data.List.NonEmpty (NonEmpty)"
915917 , test True [] "f = First" [] "import Data.Monoid (First(First))"
918+ , test True [] "f = Endo" [] "import Data.Monoid (Endo(Endo))"
919+ , test True [] "f = Version" [] "import Data.Version (Version(Version))"
920+ , test True [] "f ExitSuccess = ()" [] "import System.Exit (ExitCode(ExitSuccess))"
921+ , test True [] "f = AssertionFailed" [] "import Control.Exception (AssertionFailed(AssertionFailed))"
916922 , test True ["Prelude"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)"
917− , test True [] "f :: Alternative f => f ()" ["f = undefined"] "import GHC.Base (Alternative)"
918− , test True [] "f = empty" [] "import GHC.Base (Alternative(empty))"
923+ , test True [] "f :: Alternative f => f ()" ["f = undefined"] "import Control.Applicative (Alternative)"
924+ , test True [] "f = empty" [] "import Control.Applicative (Alternative(empty))"
919925 , test True [] "f = (&)" [] "import Data.Function ((&))"
920926 , test True [] "f = NE.nonEmpty" [] "import qualified Data.List.NonEmpty as NE"
921− , expectFailBecause "known broken - reexported name" $
922− test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)"
927+ , test True [] "f :: Typeable a => a" ["f = undefined"] "import Data.Typeable (Typeable)"
928+ , test True [] "f = pack" [] "import Data.Text (pack)"
929+ , test True [] "f :: Text" ["f = undefined"] "import Data.Text (Text)"
923930 ]
924931 ]
925932 where
926− test wanted imps def other newImp = testSession (T.unpack def) $ do
933+ test wanted imps def other newImp = testSession' (T.unpack def) $ \dir -> do
927934 let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other
928935 after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
936+ cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -]}}"
937+ liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
929938 doc <- openDoc' "Test.hs" "haskell" before
930− -- load another module in the session to exercise the package cache
931− _ <- openDoc' "Other.hs" "haskell" after
932939 _diags <- waitForDiagnostics
933940 let defLine = length imps + 1
934941 range = Range (Position defLine 0) (Position defLine maxBound)