diff --git a/hls-explicit-imports-plugin.cabal b/hls-explicit-imports-plugin.cabal --- a/hls-explicit-imports-plugin.cabal +++ b/hls-explicit-imports-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hls-explicit-imports-plugin -version: 1.0.2.0 +version: 1.1.0.0 synopsis: Explicit imports plugin for Haskell Language Server description: Please see the README on GitHub at @@ -24,9 +24,9 @@ , containers , deepseq , ghc - , ghcide ^>=1.6 + , ghcide ^>=1.7 , hls-graph - , hls-plugin-api ^>=1.3 + , hls-plugin-api ^>=1.4 , lsp , text , unordered-containers diff --git a/src/Ide/Plugin/ExplicitImports.hs b/src/Ide/Plugin/ExplicitImports.hs --- a/src/Ide/Plugin/ExplicitImports.hs +++ b/src/Ide/Plugin/ExplicitImports.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -13,6 +14,8 @@ , descriptorForModules , extractMinimalImports , within + , abbreviateImportTitle + , Log(..) ) where import Control.DeepSeq @@ -26,11 +29,14 @@ import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Text as T +import Data.String (fromString) import Development.IDE hiding (pluginHandlers, pluginRules) import Development.IDE.Core.PositionMapping +import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat import Development.IDE.Graph.Classes +import Development.IDE.Types.Logger as Logger (Pretty (pretty)) import GHC.Generics (Generic) import Ide.PluginUtils (mkLspCommand) import Ide.Types @@ -40,24 +46,33 @@ importCommandId :: CommandId importCommandId = "ImportLensCommand" +newtype Log + = LogShake Shake.Log + deriving Show + +instance Pretty Log where + pretty = \case + LogShake log -> pretty log + -- | The "main" function of a plugin -descriptor :: PluginId -> PluginDescriptor IdeState -descriptor = +descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +descriptor recorder = -- (almost) no one wants to see an explicit import list for Prelude - descriptorForModules (/= moduleName pRELUDE) + descriptorForModules recorder (/= moduleName pRELUDE) descriptorForModules - :: (ModuleName -> Bool) + :: Recorder (WithPriority Log) + -> (ModuleName -> Bool) -- ^ Predicate to select modules that will be annotated -> PluginId -> PluginDescriptor IdeState -descriptorForModules pred plId = +descriptorForModules recorder pred plId = (defaultPluginDescriptor plId) { -- This plugin provides a command handler pluginCommands = [importLensCommand], -- This plugin defines a new rule - pluginRules = minimalImportsRule, + pluginRules = minimalImportsRule recorder, pluginHandlers = mconcat [ -- This plugin provides code lenses mkPluginHandler STextDocumentCodeLens $ lensProvider pred @@ -182,11 +197,11 @@ exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}} | Just export <- hsmodExports, exports <- unLoc export - = map prettyPrint exports + = map (T.unpack . printOutputable) exports exportedModuleStrings _ = [] -minimalImportsRule :: Rules () -minimalImportsRule = define $ \MinimalImports nfp -> do +minimalImportsRule :: Recorder (WithPriority Log) -> Rules () +minimalImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \MinimalImports nfp -> do -- Get the typechecking artifacts from the module tmr <- use TypeCheck nfp -- We also need a GHC session with all the dependencies @@ -195,7 +210,7 @@ (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr let importsMap = Map.fromList - [ (realSrcSpanStart l, T.pack (prettyPrint i)) + [ (realSrcSpanStart l, printOutputable i) | L (locA -> RealSrcSpan l _) i <- fromMaybe [] mbMinImports ] res = @@ -239,7 +254,6 @@ notExported [] _ = True notExported exports (L _ ImportDecl{ideclName = L _ name}) = not $ any (\e -> ("module " ++ moduleNameString name) == e) exports - notExported _ _ = False extractMinimalImports _ _ = return ([], Nothing) mkExplicitEdit :: (ModuleName -> Bool) -> PositionMapping -> LImportDecl GhcRn -> T.Text -> Maybe TextEdit @@ -256,12 +270,19 @@ | otherwise = Nothing +-- This number is somewhat arbitrarily chosen. Ideally the protocol would tell us these things, +-- but at the moment I don't believe we know it. +-- 80 columns is traditional, but Haskellers tend to use longer lines (citation needed) and it's +-- probably not too bad if the lens is a *bit* longer than normal lines. +maxColumns :: Int +maxColumns = 120 + -- | Given an import declaration, generate a code lens unless it has an -- explicit import list or it's qualified generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens) generateLens pId uri importEdit@TextEdit {_range, _newText} = do - -- The title of the command is just the minimal explicit import decl - let title = _newText + let + title = abbreviateImportTitle _newText -- the code lens has no extra data _xdata = Nothing -- an edit that replaces the whole declaration with the explicit one @@ -273,6 +294,38 @@ _command = Just $ mkLspCommand pId importCommandId title _arguments -- create and return the code lens return $ Just CodeLens {..} + +-- | The title of the command is ideally the minimal explicit import decl, but +-- we don't want to create a really massive code lens (and the decl can be extremely large!). +-- So we abbreviate it to fit a max column size, and indicate how many more items are in the list +-- after the abbreviation +abbreviateImportTitle :: T.Text -> T.Text +abbreviateImportTitle input = + let + -- For starters, we only want one line in the title + oneLineText = T.unwords $ T.lines input + -- Now, split at the max columns, leaving space for the summary text we're going to add + -- (conservatively assuming we won't need to print a number larger than 100) + (prefix, suffix) = T.splitAt (maxColumns - (T.length (summaryText 100))) oneLineText + -- We also want to truncate the last item so we get a "clean" break, rather than half way through + -- something. The conditional here is just because 'breakOnEnd' doesn't give us quite the right thing + -- if there are actually no commas. + (actualPrefix, extraSuffix) = if T.count "," prefix > 0 then T.breakOnEnd "," prefix else (prefix, "") + actualSuffix = extraSuffix <> suffix + + -- The number of additional items is the number of commas+1 + numAdditionalItems = T.count "," actualSuffix + 1 + -- We want to make text like this: import Foo (AImport, BImport, ... (30 items)) + -- We also want it to look sensible if we end up splitting in the module name itself, + summaryText n = " ... (" <> fromString (show n) <> " items)" + -- so we only add a trailing paren if we've split in the export list + suffixText = summaryText numAdditionalItems <> if T.count "(" prefix > 0 then ")" else "" + title = + -- If the original text fits, just use it + if T.length oneLineText <= maxColumns + then oneLineText + else actualPrefix <> suffixText + in title -------------------------------------------------------------------------------- diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -16,13 +16,15 @@ import Test.Hls explicitImportsPlugin :: PluginDescriptor IdeState -explicitImportsPlugin = ExplicitImports.descriptor "explicitImports" +explicitImportsPlugin = ExplicitImports.descriptor mempty "explicitImports" +longModule :: T.Text +longModule = "F" <> T.replicate 80 "o" main :: IO () main = defaultTestRunner $ testGroup - "Refine Imports" + "Make imports explicit" [ codeActionGoldenTest "UsualCase" 3 0 , codeLensGoldenTest "UsualCase" 0 , testCase "No CodeAction when exported" $ @@ -35,6 +37,29 @@ doc <- openDoc "Exported.hs" "haskell" lenses <- getCodeLenses doc liftIO $ lenses @?= [] + , testGroup "Title abbreviation" + [ testCase "not abbreviated" $ + let i = "import " <> T.replicate 70 "F" <> " (Athing, Bthing, Cthing)" + in ExplicitImports.abbreviateImportTitle i @?= i + , testCase "abbreviated in module name" $ + let i = "import " <> T.replicate 120 "F" <> " (Athing, Bthing, Cthing)" + o = "import " <> T.replicate 97 "F" <> " ... (3 items)" + in ExplicitImports.abbreviateImportTitle i @?= o + , testCase "abbreviated in import list" $ + let i = "import " <> T.replicate 78 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)" + o = "import " <> T.replicate 78 "F" <> " (Athing, Bthing, ... (3 items))" + in ExplicitImports.abbreviateImportTitle i @?= o + -- This one breaks earlier in the same import item, but still splits the list in the same place + , testCase "abbreviated in import list (slightly shorter module)" $ + let i = "import " <> T.replicate 76 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)" + o = "import " <> T.replicate 76 "F" <> " (Athing, Bthing, ... (3 items))" + in ExplicitImports.abbreviateImportTitle i @?= o + -- This one breaks later in the same import item, but still splits the list in the same place + , testCase "abbreviated in import list (slightly longer module)" $ + let i = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)" + o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))" + in ExplicitImports.abbreviateImportTitle i @?= o + ] ] -- code action tests