ghcide 1.4.0.2 → 1.4.0.3
raw patch · 10 files changed
+136/−56 lines, 10 filesdep ~hiedbdep ~lsp-testPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: hiedb, lsp-test
API changes (from Hackage documentation)
+ Development.IDE.Types.Exports: createExportsMapHieDb :: HieDb -> IO ExportsMap
+ Development.IDE.Types.Exports: size :: ExportsMap -> Int
Files
- ghcide.cabal +5/−5
- src/Development/IDE/Core/Compile.hs +1/−1
- src/Development/IDE/Core/OfInterest.hs +8/−25
- src/Development/IDE/Core/Shake.hs +8/−0
- src/Development/IDE/GHC/ExactPrint.hs +1/−1
- src/Development/IDE/Plugin/CodeAction.hs +8/−3
- src/Development/IDE/Plugin/TypeLenses.hs +21/−8
- src/Development/IDE/Types/Exports.hs +23/−2
- src/Development/IDE/Types/Location.hs +5/−0
- test/exe/Main.hs +56/−11
ghcide.cabal view
@@ -2,7 +2,7 @@ build-type: Simple category: Development name: ghcide-version: 1.4.0.2+version: 1.4.0.3 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors@@ -59,8 +59,8 @@ hie-compat ^>= 0.2.0.0, hls-plugin-api ^>= 1.1.0.0, lens,- hiedb == 0.3.0.*,- lsp-types == 1.2.*,+ hiedb == 0.4.0.*,+ lsp-types >= 1.2 && < 1.4, lsp == 1.2.*, mtl, network-uri,@@ -343,7 +343,7 @@ hls-plugin-api, network-uri, lens,- lsp-test == 0.14.0.0,+ lsp-test ^>= 0.14, optparse-applicative, process, QuickCheck,@@ -403,7 +403,7 @@ extra, filepath, ghcide,- lsp-test == 0.14.0.0,+ lsp-test, optparse-applicative, process, safe-exceptions,
src/Development/IDE/Core/Compile.hs view
@@ -974,7 +974,7 @@ Just (LM obj_time _ _) -> obj_time > ms_hs_date ms if objUpToDate then do- hmi <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface linkable+ hmi <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface{mi_globals=Nothing} linkable return ([], Just $ mkHiFileResult ms hmi) else regen linkableNeeded (_reason, _) -> regen linkableNeeded
src/Development/IDE/Core/OfInterest.hs view
@@ -19,24 +19,19 @@ import Control.Concurrent.Strict import Control.Monad import Control.Monad.IO.Class-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as T+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as T import Development.IDE.Graph -import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe-import qualified Data.ByteString as BS-import Data.List.Extra (nubOrd)-import Data.Maybe (catMaybes)+import qualified Data.ByteString as BS+import Data.Maybe (catMaybes) import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake-import Development.IDE.Import.DependencyInformation import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Logger-import Development.IDE.Types.Options newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) instance IsIdeGlobal OfInterestVar@@ -98,25 +93,13 @@ kick :: Action () kick = do files <- HashMap.keys <$> getFilesOfInterestUntracked- ShakeExtras{progress} <- getShakeExtras+ ShakeExtras{exportsMap, progress} <- getShakeExtras liftIO $ progressUpdate progress KickStarted - -- Update the exports map for FOIs+ -- Update the exports map results <- uses GenerateCore files <* uses GetHieAst files-- -- Update the exports map for non FOIs- -- We can skip this if checkProject is True, assuming they never change under our feet.- IdeOptions{ optCheckProject = doCheckProject } <- getIdeOptions- checkProject <- liftIO doCheckProject- ifaces <- if checkProject then return Nothing else runMaybeT $ do- deps <- MaybeT $ sequence <$> uses GetDependencies files- hiResults <- lift $ uses GetModIface (nubOrd $ foldMap transitiveModuleDeps deps)- return $ map hirModIface $ catMaybes hiResults-- ShakeExtras{exportsMap} <- getShakeExtras let mguts = catMaybes results !exportsMap' = createExportsMapMg mguts- !exportsMap'' = maybe mempty createExportsMap ifaces- void $ liftIO $ modifyVar' exportsMap $ (exportsMap'' <>) . (exportsMap' <>)+ void $ liftIO $ modifyVar' exportsMap (exportsMap' <>) liftIO $ progressUpdate progress KickCompleted
src/Development/IDE/Core/Shake.hs view
@@ -152,6 +152,8 @@ import qualified Data.HashSet as HSet import Data.IORef.Extra (atomicModifyIORef'_, atomicModifyIORef_)+import Data.Text (pack)+import qualified Development.IDE.Types.Exports as ExportsMap import HieDb.Types import Ide.Plugin.Config import qualified Ide.PluginUtils as HLS@@ -507,6 +509,12 @@ indexProgressToken <- newVar Nothing let hiedbWriter = HieDbWriter{..} exportsMap <- newVar mempty+ -- lazily initialize the exports map with the contents of the hiedb+ _ <- async $ do+ logDebug logger "Initializing exports map from hiedb"+ em <- createExportsMapHieDb hiedb+ modifyVar' exportsMap (<> em)+ logDebug logger $ "Done initializing exports map from hiedb (" <> pack(show (ExportsMap.size em)) <> ")" progress <- do let (before, after) = if testing then (0,0.1) else (0.1,0.1)
src/Development/IDE/GHC/ExactPrint.hs view
@@ -188,7 +188,7 @@ -- | (Needs parens, needs space) (All, All) needsParensSpace HsLam{} = (All False, All False)-needsParensSpace HsLamCase{} = (All False, All False)+needsParensSpace HsLamCase{} = (All False, All True) needsParensSpace HsApp{} = mempty needsParensSpace HsAppType{} = mempty needsParensSpace OpApp{} = mempty
src/Development/IDE/Plugin/CodeAction.hs view
@@ -804,6 +804,10 @@ = mod_srcspan >>= uncurry (suggestions hsmodImports binding) | otherwise = [] where+ canUseDatacon = case extractNotInScopeName _message of+ Just NotInScopeTypeConstructorOrClass{} -> False+ _ -> True+ suggestions decls binding mod srcspan | range <- case [ x | (x,"") <- readSrcSpan (T.unpack srcspan)] of [s] -> let x = realSrcSpanToRange s@@ -823,7 +827,7 @@ -- Only for the situation that data constructor name is same as type constructor name, -- let ident with parent be in front of the one without. , sortedMatch <- sortBy (\ident1 ident2 -> parent ident2 `compare` parent ident1) (Set.toList match)- , idents <- filter (\ident -> moduleNameText ident == mod) sortedMatch+ , idents <- filter (\ident -> moduleNameText ident == mod && (canUseDatacon || not (isDatacon ident))) sortedMatch , (not . null) idents -- Ensure fallback while `idents` is empty , ident <- head idents = Just ident@@ -1318,8 +1322,9 @@ hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True canUseIdent :: NotInScope -> IdentInfo -> Bool-canUseIdent NotInScopeDataConstructor{} = isDatacon-canUseIdent _ = const True+canUseIdent NotInScopeDataConstructor{} = isDatacon+canUseIdent NotInScopeTypeConstructorOrClass{} = not . isDatacon+canUseIdent _ = const True data NotInScope = NotInScopeDataConstructor T.Text
src/Development/IDE/Plugin/TypeLenses.hs view
@@ -21,7 +21,7 @@ import qualified Data.Aeson.Types as A import qualified Data.HashMap.Strict as Map import Data.List (find)-import Data.Maybe (catMaybes, fromJust)+import Data.Maybe (catMaybes) import qualified Data.Text as T import Development.IDE (GhcSession (..), HscEnvEq (hscEnv),@@ -36,7 +36,6 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Util (printName) import Development.IDE.Graph.Classes-import Development.IDE.Spans.Common (safeTyThingType) import Development.IDE.Spans.LocalBindings (Bindings, getFuzzyScope) import Development.IDE.Types.Location (Position (Position, _character, _line), Range (Range, _end, _start),@@ -46,8 +45,7 @@ import GhcPlugins (GlobalRdrEnv, HscEnv (hsc_dflags), SDoc, elemNameSet, getSrcSpan,- idName, lookupTypeEnv,- mkRealSrcLoc,+ idName, mkRealSrcLoc, realSrcLocSpan, tidyOpenType) import HscTypes (mkPrintUnqualified)@@ -76,7 +74,12 @@ TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit)) import Outputable (showSDocForUser)-import PatSyn (patSynName)+import PatSyn (PatSyn, mkPatSyn,+ patSynBuilder,+ patSynFieldLabels,+ patSynIsInfix,+ patSynMatcher, patSynName,+ patSynSig, pprPatSynType) import TcEnv (tcInitTidyEnv) import TcRnMonad (initTcWithGbl) import TcRnTypes (TcGblEnv (..))@@ -279,10 +282,20 @@ pure $ GlobalBindingTypeSig name (printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports) patToSig p = do let name = patSynName p- -- we don't use pprPatSynType, since it always prints forall- ty = fromJust $ lookupTypeEnv (tcg_type_env gblEnv) name >>= safeTyThingType- hasSig name $ pure $ GlobalBindingTypeSig name ("pattern " <> printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports)+ hasSig name $ pure $ GlobalBindingTypeSig name ("pattern " <> printName name <> " :: " <> showDoc (pprPatSynTypeWithoutForalls p)) (name `elemNameSet` exports) (_, maybe [] catMaybes -> bindings) <- initTcWithGbl hsc gblEnv (realSrcLocSpan $ mkRealSrcLoc "<dummy>" 1 1) $ mapM bindToSig binds patterns <- catMaybes <$> mapM patToSig patSyns pure . Just . GlobalBindingTypeSigsResult $ bindings <> patterns gblBindingType _ _ = pure Nothing++pprPatSynTypeWithoutForalls :: PatSyn -> SDoc+pprPatSynTypeWithoutForalls p = pprPatSynType pWithoutTypeVariables+ where+ pWithoutTypeVariables = mkPatSyn name declared_infix ([], req_theta) ([], prov_theta) orig_args' orig_res_ty matcher builder field_labels+ (_univ_tvs, req_theta, _ex_tvs, prov_theta, orig_args, orig_res_ty) = patSynSig p+ name = patSynName p+ declared_infix = patSynIsInfix p+ matcher = patSynMatcher p+ builder = patSynBuilder p+ field_labels = patSynFieldLabels p+ orig_args' = map scaledThing orig_args
src/Development/IDE/Types/Exports.hs view
@@ -7,12 +7,13 @@ createExportsMap, createExportsMapMg, createExportsMapTc-) where+,createExportsMapHieDb,size) where import Avail (AvailInfo (..)) import Control.DeepSeq (NFData (..))+import Control.Monad import Data.Bifunctor (Bifunctor (second))-import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict (HashMap, elems) import qualified Data.HashMap.Strict as Map import Data.HashSet (HashSet) import qualified Data.HashSet as Set@@ -23,6 +24,7 @@ import FieldLabel (flSelector) import GHC.Generics (Generic) import GhcPlugins (IfaceExport, ModGuts (..))+import HieDb import Name import TcRnTypes (TcGblEnv (..)) @@ -30,6 +32,9 @@ {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)} deriving newtype (Monoid, NFData, Show) +size :: ExportsMap -> Int+size = sum . map length . elems . getExportsMap+ instance Semigroup ExportsMap where ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b @@ -103,6 +108,22 @@ doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (tcg_exports mi) where mn = moduleName $ tcg_mod mi++createExportsMapHieDb :: HieDb -> IO ExportsMap+createExportsMapHieDb hiedb = do+ mods <- getAllIndexedMods hiedb+ idents <- forM mods $ \m -> do+ let mn = modInfoName $ hieModInfo m+ mText = pack $ moduleNameString mn+ fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn+ return $ ExportsMap $ Map.fromListWith (<>) (concat idents)+ where+ wrap identInfo = (name identInfo, Set.fromList [identInfo])+ -- unwrap :: ExportRow -> IdentInfo+ unwrap m ExportRow{..} = IdentInfo n n p exportIsDatacon m+ where+ n = pack (occNameString exportName)+ p = pack . occNameString <$> exportParent unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])] unpackAvail !(pack . moduleNameString -> mod) = map f . mkIdentInfos mod
src/Development/IDE/Types/Location.hs view
@@ -1,5 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0+{-# LANGUAGE CPP #-} -- | Types and functions for working with source code locations.@@ -43,7 +44,11 @@ toNormalizedFilePath' fp = LSP.toNormalizedFilePath fp emptyFilePath :: LSP.NormalizedFilePath+#if MIN_VERSION_lsp_types(1,3,0)+emptyFilePath = LSP.normalizedFilePath emptyPathUri ""+#else emptyFilePath = LSP.NormalizedFilePath emptyPathUri ""+#endif -- | We use an empty string as a filepath when we don’t have a file. -- However, haskell-lsp doesn’t support that in uriToFilePath and given
test/exe/Main.hs view
@@ -730,7 +730,7 @@ , typeWildCardActionTests , removeImportTests , extendImportTests- , suggesImportClassMethodTests+ , suggestImportClassMethodTests , suggestImportTests , suggestHideShadowTests , suggestImportDisambiguationTests@@ -1436,6 +1436,25 @@ , "f :: Foo" , "f = Foo 1" ])+ , testSession "type constructor name same as data constructor name, data constructor extraneous" $ template+ [("ModuleA.hs", T.unlines+ [ "module ModuleA where"+ , "data Foo = Foo"+ ])]+ ("ModuleB.hs", T.unlines+ [ "module ModuleB where"+ , "import ModuleA()"+ , "f :: Foo"+ , "f = undefined"+ ])+ (Range (Position 2 4) (Position 2 6))+ ["Add Foo to the import list of ModuleA"]+ (T.unlines+ [ "module ModuleB where"+ , "import ModuleA(Foo)"+ , "f :: Foo"+ , "f = undefined"+ ]) ] where codeActionTitle CodeAction{_title=x} = x@@ -1486,8 +1505,8 @@ template message expected = do liftIO $ matchRegExMultipleImports message @=? expected -suggesImportClassMethodTests :: TestTree-suggesImportClassMethodTests =+suggestImportClassMethodTests :: TestTree+suggestImportClassMethodTests = testGroup "suggest import class methods" [ testGroup@@ -1566,6 +1585,8 @@ , test False [] "f = quickCheck" [] "import Test.QuickCheck (quickCheck)" -- don't omit the parent data type of a constructor , test False [] "f ExitSuccess = ()" [] "import System.Exit (ExitSuccess)"+ -- don't suggest data constructor when we only need the type+ , test False [] "f :: Bar" [] "import Bar (Bar(Bar))" ] , testGroup "want suggestion" [ wantWait [] "f = foo" [] "import Foo (foo)"@@ -2890,17 +2911,21 @@ addSigActionTests :: TestTree addSigActionTests = let- header = "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures #-}"- moduleH = "{-# LANGUAGE PatternSynonyms #-}\nmodule Sigs where"- before def = T.unlines [header, moduleH, def]- after' def sig = T.unlines [header, moduleH, sig, def]+ header = [ "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures #-}"+ , "{-# LANGUAGE PatternSynonyms,BangPatterns,GADTs #-}"+ , "module Sigs where"+ , "data T1 a where"+ , " MkT1 :: (Show b) => a -> b -> T1 a"+ ]+ before def = T.unlines $ header ++ [def]+ after' def sig = T.unlines $ header ++ [sig, def] - def >:: sig = testSession (T.unpack def) $ do+ def >:: sig = testSession (T.unpack $ T.replace "\n" "\\n" def) $ do let originalCode = before def let expectedCode = after' def sig doc <- createDoc "Sigs.hs" "haskell" originalCode _ <- waitForDiagnostics- actionsOrCommands <- getCodeActions doc (Range (Position 3 1) (Position 3 maxBound))+ actionsOrCommands <- getCodeActions doc (Range (Position 5 1) (Position 5 maxBound)) chosenAction <- liftIO $ pickActionWithTitle ("add signature: " <> sig) actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc@@ -2914,6 +2939,15 @@ , "a >>>> b = a + b" >:: "(>>>>) :: Num a => a -> a -> a" , "a `haha` b = a b" >:: "haha :: (t1 -> t2) -> t1 -> t2" , "pattern Some a = Just a" >:: "pattern Some :: a -> Maybe a"+ , "pattern Some a <- Just a" >:: "pattern Some :: a -> Maybe a"+ , "pattern Some a <- Just a\n where Some a = Just a" >:: "pattern Some :: a -> Maybe a"+ , "pattern Some a <- Just !a\n where Some !a = Just a" >:: "pattern Some :: a -> Maybe a"+ , "pattern Point{x, y} = (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+ , "pattern Point{x, y} <- (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+ , "pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)" >:: "pattern Point :: a -> b -> (a, b)"+ , "pattern MkT1' b = MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"+ , "pattern MkT1' b <- MkT1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a"+ , "pattern MkT1' b <- MkT1 42 b\n where MkT1' b = T1 42 b" >:: "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a" ] exportUnusedTests :: TestTree@@ -3377,10 +3411,12 @@ let pragmas = "{-# OPTIONS_GHC -Wmissing-signatures -Wmissing-pattern-synonym-signatures #-}" moduleH exported = T.unlines- [ "{-# LANGUAGE PatternSynonyms,TypeApplications,DataKinds,RankNTypes,ScopedTypeVariables,TypeOperators #-}"+ [ "{-# LANGUAGE PatternSynonyms,TypeApplications,DataKinds,RankNTypes,ScopedTypeVariables,TypeOperators,GADTs,BangPatterns #-}" , "module Sigs(" <> exported <> ") where" , "import qualified Data.Complex as C" , "import Data.Data (Proxy (..), type (:~:) (..), mkCharType)"+ , "data T1 a where"+ , " MkT1 :: (Show b) => a -> b -> T1 a" ] before enableGHCWarnings exported (def, _) others = T.unlines $ [pragmas | enableGHCWarnings] <> [moduleH exported, def] <> others@@ -3409,6 +3445,15 @@ , ("a >>>> b = a + b", "(>>>>) :: Num a => a -> a -> a") , ("a `haha` b = a b", "haha :: (t1 -> t2) -> t1 -> t2") , ("pattern Some a = Just a", "pattern Some :: a -> Maybe a")+ , ("pattern Some a <- Just a", "pattern Some :: a -> Maybe a")+ , ("pattern Some a <- Just a\n where Some a = Just a", "pattern Some :: a -> Maybe a")+ , ("pattern Some a <- Just !a\n where Some !a = Just a", "pattern Some :: a -> Maybe a")+ , ("pattern Point{x, y} = (x, y)", "pattern Point :: a -> b -> (a, b)")+ , ("pattern Point{x, y} <- (x, y)", "pattern Point :: a -> b -> (a, b)")+ , ("pattern Point{x, y} <- (x, y)\n where Point x y = (x, y)", "pattern Point :: a -> b -> (a, b)")+ , ("pattern MkT1' b = MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a")+ , ("pattern MkT1' b <- MkT1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a")+ , ("pattern MkT1' b <- MkT1 42 b\n where MkT1' b = T1 42 b", "pattern MkT1' :: (Eq a, Num a) => Show b => b -> T1 a") , ("qualifiedSigTest= C.realPart", "qualifiedSigTest :: C.Complex a -> a") , ("head = 233", "head :: Integer") , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")")@@ -3419,7 +3464,7 @@ ] in testGroup "add signature"- [ testGroup "signatures are correct" [sigSession (T.unpack def) False "always" "" (def, Just sig) [] | (def, sig) <- cases]+ [ testGroup "signatures are correct" [sigSession (T.unpack $ T.replace "\n" "\\n" def) False "always" "" (def, Just sig) [] | (def, sig) <- cases] , sigSession "exported mode works" False "exported" "xyz" ("xyz = True", Just "xyz :: Bool") (fst <$> take 3 cases) , testGroup "diagnostics mode works"