import lens plugin

Author: pepeiborra

exe/Main.hs

@@ -69,6 +69,7 @@ import Ide.Plugin.Example2                as Example2
 import Ide.Plugin.GhcIde                  as GhcIde
 import Ide.Plugin.Floskell                as Floskell
 import Ide.Plugin.Fourmolu                as Fourmolu
+import Ide.Plugin.ImportLens              as ImportLens
 import Ide.Plugin.Ormolu                  as Ormolu
 import Ide.Plugin.StylishHaskell          as StylishHaskell
 import Ide.Plugin.Retrie                  as Retrie
@@ -114,6 +115,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
       , Brittany.descriptor    "brittany"
 #endif
       , Eval.descriptor "eval"
+      , ImportLens.descriptor "importLens"
       ]
     examplePlugins =
       [Example.descriptor  "eg"

haskell-language-server.cabal

@@ -47,6 +47,7 @@ library
       Ide.Plugin.Example2
       Ide.Plugin.Fourmolu
       Ide.Plugin.GhcIde
+      Ide.Plugin.ImportLens
       Ide.Plugin.Ormolu
       Ide.Plugin.Pragmas
       Ide.Plugin.Retrie

src/Ide/Plugin/ImportLens.hs

@@ -0,0 +1,124 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+module Ide.Plugin.ImportLens (descriptor) where
+import Control.Monad (forM)
+import Data.Aeson (ToJSON)
+import Data.Aeson (Value(Null))
+import Data.Aeson.Types (FromJSON)
+import Data.IORef (readIORef)
+import Data.Map (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe, catMaybes)
+import qualified Data.Text as T
+import Development.IDE
+import Development.IDE.GHC.Compat
+import GHC.Generics (Generic)
+import Ide.Plugin
+import Ide.Types
+import Language.Haskell.LSP.Types
+import RnNames (getMinimalImports, findImportUsage)
+import TcRnMonad (initTcWithGbl)
+import TcRnTypes (TcGblEnv(tcg_used_gres))
+import PrelNames (pRELUDE)
+import Data.Aeson (ToJSON(toJSON))
+import qualified Data.HashMap.Strict as HashMap
+
+importCommandId :: CommandId
+importCommandId = "ImportLensCommand"
+
+descriptor :: PluginId -> PluginDescriptor
+descriptor plId = (defaultPluginDescriptor plId) {
+    pluginCodeLensProvider = Just provider,
+    pluginCommands = [ importLensCommand ]
+}
+
+importLensCommand :: PluginCommand
+importLensCommand =
+    PluginCommand importCommandId "Explicit import command" runImportCommand
+
+data ImportCommandParams = ImportCommandParams WorkspaceEdit
+  deriving Generic
+  deriving anyclass (FromJSON, ToJSON)
+
+runImportCommand :: CommandFunction ImportCommandParams
+runImportCommand _lspFuncs _state (ImportCommandParams edit) = do
+    return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams edit))
+
+-- For every implicit import statement,
+-- return a code lens of the corresponding explicit import
+-- Example. For the module below:
+--
+-- > import Data.List
+-- >
+-- > f = intercalate " " . sortBy length
+--
+-- the provider should produce one code lens:
+--
+-- > import Data.List (intercalate, sortBy)
+
+provider :: CodeLensProvider
+provider _lspFuncs state pId CodeLensParams{..}
+  | TextDocumentIdentifier{_uri} <- _textDocument
+  , Just nfp <- uriToNormalizedFilePath $ toNormalizedUri _uri
+  = do
+    Just (tmr, _) <- runIde state $ useWithStaleFast TypeCheck nfp
+    hsc <- hscEnv <$> runAction "importLens" state (use_ GhcSessionDeps nfp)
+    (imports, mbMinImports) <- extractMinimalImports hsc (tmrModule tmr)
+
+    case mbMinImports of
+        Just minImports -> do
+            let minImportsMap =
+                    Map.fromList [ (srcSpanStart l, i) | L l i <- minImports ]
+            commands <- forM imports $ generateLens pId _uri minImportsMap
+            return $ Right (List $ catMaybes commands)
+        _ ->
+            return $ Right (List [])
+
+  | otherwise
+  = return $ Right (List [])
+
+extractMinimalImports :: HscEnv -> TypecheckedModule -> IO ([LImportDecl GhcRn], Maybe [LImportDecl GhcRn])
+extractMinimalImports hsc TypecheckedModule{..} = do
+    let (tcEnv,_) = tm_internals_
+        Just (_, imports, _, _) = tm_renamed_source
+        ParsedModule{ pm_parsed_source = L loc _} = tm_parsed_module
+
+    gblElts <- readIORef (tcg_used_gres tcEnv)
+    let usage = findImportUsage imports gblElts
+        span = fromMaybe (error "expected real") $ realSpan loc
+    (_, minimalImports) <- initTcWithGbl hsc tcEnv span $ getMinimalImports usage
+    return (imports, minimalImports)
+
+generateLens :: PluginId -> Uri -> Map SrcLoc (ImportDecl GhcRn) -> LImportDecl GhcRn -> IO (Maybe CodeLens)
+generateLens pId uri minImports (L src imp)
+  | ImportDecl{ideclHiding = Just (False,_)} <- imp
+  = return Nothing
+  | RealSrcSpan l <- src
+  , Just explicit <- Map.lookup (srcSpanStart src) minImports
+  , L _ mn <- ideclName imp
+  , mn /= moduleName pRELUDE
+  = do
+    let title = T.pack $ prettyPrint explicit
+        commandArgs = Nothing
+    c <- mkLspCommand pId importCommandId title commandArgs
+    let _range :: Range = realSrcSpanToRange l
+        _xdata = Nothing
+        edit = WorkspaceEdit (Just editsMap) Nothing
+        editsMap = HashMap.fromList [(uri, List [importEdit])]
+        importEdit = TextEdit _range title
+        args = ImportCommandParams edit
+        _arguments = Just (List [toJSON args])
+        _command = Just (c :: Command){_arguments}
+    return $ Just CodeLens{..}
+  | otherwise
+  = return Nothing
+
+runIde :: IdeState -> IdeAction a -> IO a
+runIde state = runIdeAction "importLens" (shakeExtras state)