ghcide: m refactors

Author: Anton-Latukha

ghcide/src/Development/IDE/Core/Compile.hs

@@ -694,7 +694,7 @@ mergeEnvs :: HscEnv -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv
 mergeEnvs env extraModSummaries extraMods envs = do
     prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs
     let ims  = map (Compat.installedModule (homeUnitId_ $ hsc_dflags env) . moduleName . ms_mod) extraModSummaries
-        ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims
+        ifrs = zipWith (InstalledFound . ms_location) extraModSummaries ims
     newFinderCache <- newIORef $
             foldl'
                 (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache
@@ -992,6 +992,7 @@ getDocsBatch
   :: HscEnv
   -> Module  -- ^ a moudle where the names are in scope
   -> [Name]
+  --  2021-11-18: NOTE: Map Int would become IntMap if next GHCs.
   -> IO (Either ErrorMessages (Map.Map Name (Either GetDocsFailure (Maybe HsDocString, Maybe (Map.Map Int HsDocString)))))
   -- ^ Return a 'Map' of 'Name's to 'Either' (no docs messages) (general doc body & arg docs)
 getDocsBatch hsc_env _mod _names = do

ghcide/src/Development/IDE/Core/Rules.hs

@@ -553,9 +553,9 @@ getBindingsRule :: Rules ()
 getBindingsRule =
   define $ \GetBindings f -> do
     HAR{hieKind=kind, refMap=rm} <- use_ GetHieAst f
-    case kind of
-      HieFresh      -> pure ([], Just $ bindings rm)
-      HieFromDisk _ -> pure ([], Nothing)
+    pure . (mempty,) $ case kind of
+      HieFresh      -> Just $ bindings rm
+      HieFromDisk _ -> Nothing
 
 getDocMapRule :: Rules ()
 getDocMapRule =
@@ -667,8 +667,7 @@ loadGhcSession ghcSessionDepsConfig = do
                 afp <- liftIO $ makeAbsolute fp
                 let nfp = toNormalizedFilePath' afp
                 itExists <- getFileExists nfp
-                when itExists $ void $ do
-                  use_ GetModificationTime nfp
+                when itExists $ void $ use_ GetModificationTime nfp
         mapM_ addDependency deps
 
         opts <- getIdeOptions
@@ -702,7 +701,7 @@ ghcSessionDepsDefinition :: GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePa
 ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
     let hsc = hscEnv env
 
-    mbdeps <- mapM(fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
+    mbdeps <- traverse (fmap artifactFilePath . snd) <$> use_ GetLocatedImports file
     case mbdeps of
         Nothing -> return Nothing
         Just deps -> do

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -54,6 +54,7 @@ import           Data.List.Extra                      (dropEnd1, nubOrd)
 import           Data.Version                         (showVersion)
 import           HieDb                                hiding (pointCommand)
 import           System.Directory                     (doesFileExist)
+import           Data.Bool                            (bool)
 
 -- | Gives a Uri for the module, given the .hie file location and the the module info
 -- The Bool denotes if it is a boot module
@@ -63,13 +64,13 @@ type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri
 newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping))
 
 computeTypeReferences :: Foldable f => f (HieAST Type) -> M.Map Name [Span]
-computeTypeReferences = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty
+computeTypeReferences = foldr (\ast m -> M.unionWith (<>) (go ast) m) M.empty
   where
     go ast = M.unionsWith (++) (this : map go (nodeChildren ast))
       where
         this = M.fromListWith (++)
           $ map (, [nodeSpan ast])
-          $ concatMap namesInType
+          $ foldMap namesInType
           $ mapMaybe (\x -> guard (not $ all isOccurrence $ identInfo x) *> identType x)
           $ M.elems
           $ nodeIdentifiers $ nodeInfo ast
@@ -212,9 +213,9 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
     -- | Get hover info for values/data
     hoverInfo ast = (Just range, prettyNames ++ pTypes)
       where
-        pTypes
-          | Prelude.length names == 1 = dropEnd1 $ map wrapHaskell prettyConcreteTypes
-          | otherwise = map wrapHaskell prettyConcreteTypes
+        pTypes =
+          bool id dropEnd1 (Prelude.length names == 1)
+            $ map wrapHaskell prettyConcreteTypes
 
         range = realSrcSpanToRange $ nodeSpan ast
 

ghcide/src/Development/IDE/Spans/Common.hs

@@ -97,9 +97,7 @@ spanDocToMarkdownForTest
   = haddockToMarkdown . H.toRegular . H._doc . H.parseParas Nothing
 
 -- Simple (and a bit hacky) conversion from Haddock markup to Markdown
-haddockToMarkdown
-  :: H.DocH String String -> String
-
+haddockToMarkdown :: H.DocH String String -> String
 haddockToMarkdown H.DocEmpty
   = ""
 haddockToMarkdown (H.DocAppend d1 d2)