Skip to content

Commit

Permalink
formatting and docs
Browse files Browse the repository at this point in the history
  • Loading branch information
VenInf committed Aug 14, 2024
1 parent 2ff597a commit 5cc3906
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 27 deletions.
47 changes: 22 additions & 25 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,20 @@ import Development.IDE.Graph (Key,
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
import Development.IDE.Types.Shake (toKey)
import qualified Distribution.Fields as Syntax
import Distribution.PackageDescription (Benchmark (..),
BuildInfo (..),
Executable (..),
ForeignLib (..),
Library (..),
LibraryName (LMainLibName, LSubLibName),
PackageDescription (..),
TestSuite (..),
library,
unUnqualComponentName)
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import qualified Distribution.Parsec.Position as Syntax
import Distribution.Utils.Generic (safeHead)
import Distribution.Utils.Path (getSymbolicPath)
import GHC.Generics
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
Expand All @@ -52,23 +65,9 @@ import qualified Language.LSP.Protocol.Lens as JL
import qualified Language.LSP.Protocol.Message as LSP
import Language.LSP.Protocol.Types
import qualified Language.LSP.VFS as VFS

import Debug.Trace
import Distribution.PackageDescription (Benchmark (..),
BuildInfo (..),
Executable (..),
ForeignLib (..),
Library (..),
LibraryName (LMainLibName, LSubLibName),
PackageDescription (..),
TestSuite (..),
library,
unUnqualComponentName)
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import Distribution.Utils.Path (getSymbolicPath)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory)
import Distribution.Utils.Generic (safeHead)
import System.Directory (doesFileExist)
import System.FilePath (takeDirectory,
(</>))

data Log
= LogModificationTime NormalizedFilePath FileVersion
Expand Down Expand Up @@ -302,11 +301,12 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif

-- | CodeActions for going to definitions.
--
-- Provides a CodeAction for going to a definition when clicking on an identifier.
-- Provides a CodeAction for going to a definition when clicking on an identifier
-- and clicking on exposed-module or other-module field.
-- The definition is found by traversing the sections and comparing their name to
-- the clicked identifier.
-- the clicked identifier. If it's not in sections it attempts to find it in module names.
--
-- TODO: Support more definitions than sections.
-- TODO: Resolve more cases for go-to definition.
gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
gotoDefinition ideState _ msgParam = do
case uriToFilePath' uri of
Expand Down Expand Up @@ -340,13 +340,10 @@ gotoDefinition ideState _ msgParam = do
mBuildTargetNames
sourceDirs = map getSymbolicPath $ concatMap hsSourceDirs buildInfos
potentialPaths = map (\dir -> takeDirectory filePath </> dir </> toHaskellFile moduleName) sourceDirs
traceShowM ("potentialPaths", potentialPaths)
allPaths <- liftIO $ filterM doesFileExist potentialPaths
traceShowM ("allPaths", allPaths)
let locations = map (\pth -> Location (filePathToUri pth) (mkRange 0 0 0 0)) allPaths
traceShowM ("locations", locations)
case safeHead locations of
Nothing -> pure $ InR $ InR Null
case safeHead locations of -- We assume there could be only one source location
Nothing -> pure $ InR $ InR Null
Just location -> pure $ InL $ Definition $ InL location
where
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,9 @@ import qualified Data.Text.Encoding as T
import Data.Tuple (swap)
import qualified Distribution.Fields as Syntax
import qualified Distribution.Parsec.Position as Syntax
import Ide.Plugin.Cabal.Completion.Types
( cabalPositionToLSPPosition, FieldContext(None), StanzaContext )
import Ide.Plugin.Cabal.Completion.Types (FieldContext (None),
StanzaContext,
cabalPositionToLSPPosition)
import qualified Language.LSP.Protocol.Types as LSP

-- ----------------------------------------------------------------
Expand Down Expand Up @@ -142,6 +143,34 @@ getOptionalSectionName (x:xs) = case x of
type BuildTargetName = T.Text
type ModuleName = T.Text

-- | Given a cabal AST returns pairs of all respective target names
-- and the module name bounded to them. If a target is a main library gives
-- @Nothing@, otherwise @Just target-name@
--
-- Examples of input cabal files and the outputs:
--
-- * Target is a main library module:
--
-- > library
-- > exposed-modules:
-- > MyLib
--
-- * @getModulesNames@ output:
--
-- > [([Nothing], "MyLib")]
--
-- * Same module names in different targets:
--
-- > test-suite first-target
-- > other-modules:
-- > Config
-- > test-suite second-target
-- > other-modules:
-- > Config
--
-- * @getModulesNames@ output:
--
-- > [([Just "first-target", Just "second-target"], "Config")]
getModulesNames :: [Syntax.Field any] -> [([Maybe BuildTargetName], ModuleName)]
getModulesNames fields = map swap $ groupSort rawModuleTargetPairs
where
Expand All @@ -162,6 +191,38 @@ getModulesNames fields = map swap $ groupSort rawModuleTargetPairs
else []
getFieldModuleNames _ = []

-- | Trims a given cabal AST leaving only targets and their
-- @exposed-modules@ and @other-modules@ sections.
--
-- For examle:
--
-- * Given a cabal file like this:
--
-- > library
-- > import: extra
-- > hs-source-dirs: source/directory
-- > ...
-- > exposed-modules:
-- > Importaint.Exposed.Module
-- > other-modules:
-- > Importaint.Other.Module
-- >
-- > test-suite tests
-- > type: type
-- > build-tool-depends: tool
-- > other-modules:
-- > Importaint.Other.Module
--
-- * @getSectionsWithModules@ gives output:
--
-- > library
-- > exposed-modules:
-- > Importaint.Exposed.Module
-- > other-modules:
-- > Importaint.Other.Module
-- > test-suite tests
-- > other-modules:
-- > Importaint.Other.Module
getSectionsWithModules :: [Syntax.Field any] -> [Syntax.Field any]
getSectionsWithModules fields = concatMap go fields
where
Expand Down

0 comments on commit 5cc3906

Please sign in to comment.