import lens plugin

This commit is contained in:
Pepe Iborra 2020-08-09 11:37:34 +01:00
parent 0b12fcb4a2
commit 6fdd7d4338
3 changed files with 127 additions and 0 deletions

View File

@ -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"

View File

@ -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

View File

@ -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)