Skip to content

Commit

Permalink
Refactor module structure of cabal completion system
Browse files Browse the repository at this point in the history
  • Loading branch information
@VeryMilkyJoe
VeryMilkyJoe committed Jun 30, 2023
1 parent 17f0ddd commit f951657
Show file tree
Hide file tree
Showing 12 changed files with 998 additions and 903 deletions.
11 changes: 8 additions & 3 deletions plugins/hls-cabal-plugin/hls-cabal-plugin.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,11 +27,16 @@ library
exposed-modules:
Ide.Plugin.Cabal
Ide.Plugin.Cabal.Diagnostics
Ide.Plugin.Cabal.Completions
Ide.Plugin.Cabal.FilepathCompletions
Ide.Plugin.Cabal.Completion.Completions
Ide.Plugin.Cabal.Completion.Types
Ide.Plugin.Cabal.Completion.Data
Ide.Plugin.Cabal.Completion.Completer.FilePath
Ide.Plugin.Cabal.Completion.Completer.Module
Ide.Plugin.Cabal.Completion.Completer.Simple
Ide.Plugin.Cabal.Completion.Completer.Types
Ide.Plugin.Cabal.Completion.Completer.Snippet
Ide.Plugin.Cabal.LicenseSuggest
Ide.Plugin.Cabal.Parse
Ide.Plugin.Cabal.Types


build-depends:
Expand Down
46 changes: 24 additions & 22 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,31 +16,33 @@ import Control.Concurrent.Strict
import Control.DeepSeq
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (runMaybeT)
import qualified Data.ByteString as BS
import Control.Monad.Trans.Maybe (runMaybeT)
import qualified Data.ByteString as BS
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text.Encoding as Encoding
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Text.Encoding as Encoding
import Data.Typeable
import Development.IDE as D
import Development.IDE.Core.Shake (restartShakeSession)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Graph (alwaysRerun)
import Distribution.Compat.Lens ((^.))
import Development.IDE as D
import Development.IDE.Core.Shake (restartShakeSession)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Graph (alwaysRerun)
import Distribution.Compat.Lens ((^.))
import GHC.Generics
import qualified Ide.Plugin.Cabal.Completions as Completions
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import qualified Ide.Plugin.Cabal.Parse as Parse
import qualified Ide.Plugin.Cabal.Types as Types
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
import qualified Ide.Plugin.Cabal.Completion.Types as Types
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import qualified Ide.Plugin.Cabal.Parse as Parse
import Ide.Types
import qualified Language.LSP.Protocol.Lens as JL
import qualified Language.LSP.Protocol.Message as LSP
import qualified Language.LSP.Protocol.Lens as JL
import qualified Language.LSP.Protocol.Message as LSP
import Language.LSP.Protocol.Types
import Language.LSP.Server (LspM, getVirtualFile)
import qualified Language.LSP.VFS as VFS
import Language.LSP.Server (LspM,
getVirtualFile)
import qualified Language.LSP.VFS as VFS

data Log
= LogModificationTime NormalizedFilePath FileVersion
Expand Down Expand Up @@ -292,13 +294,13 @@ completion recorder ide _ complParams = do
Just ctx -> do
logWith recorder Debug $ LogCompletionContext ctx pos
let completer = Completions.contextToCompleter ctx
let completerData = Types.CompleterData
let completerData = CompleterTypes.CompleterData
{ ideState = ide
, cabalPrefixInfo = completionContext
, stanzaName =
case fst ctx of
Types.Stanza _ name -> name
_ -> Nothing
_ -> Nothing
}
completions <- completer completerRecorder completerData
pure completions
Expand Down
138 changes: 62 additions & 76 deletions ...c/Ide/Plugin/Cabal/FilepathCompletions.hs → ...in/Cabal/Completion/Completer/FilePath.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,22 +2,69 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ide.Plugin.Cabal.FilepathCompletions where

import Control.Exception (evaluate, try)
import Control.Monad (filterM)
import Control.Monad.Extra (concatForM, forM)
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T

module Ide.Plugin.Cabal.Completion.Completer.FilePath where

import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Ide.Plugin.Cabal.Completion.Completer.Types

import Control.Exception (evaluate, try)
import Control.Monad (filterM)
import Control.Monad.Extra (forM)
import Development.IDE.Types.Logger
import Ide.Plugin.Cabal.Types
import System.Directory (doesDirectoryExist,
doesFileExist, listDirectory)
import qualified System.FilePath as FP
import System.FilePath (dropExtension)
import qualified System.FilePath.Posix as Posix
import qualified Text.Fuzzy.Parallel as Fuzzy
import Ide.Plugin.Cabal.Completion.Types
import System.Directory (doesDirectoryExist,
doesFileExist,
listDirectory)
import qualified System.FilePath as FP
import qualified System.FilePath.Posix as Posix
import qualified Text.Fuzzy.Parallel as Fuzzy
import Ide.Plugin.Cabal.Completion.Completer.Simple


{- | Completer to be used when a file path can be
completed for a field, takes the file path of the directory to start from.
Completes file paths as well as directories.
-}
filePathCompleter :: Completer
filePathCompleter recorder cData = do
let prefInfo = cabalPrefixInfo cData
suffix = fromMaybe "" $ completionSuffix prefInfo
complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo
toMatch = fromMaybe (partialFileName complInfo) $ T.stripPrefix "./" $ partialFileName complInfo
filePathCompletions <- listFileCompletions recorder complInfo
let scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions)
forM
scored
( \compl' -> do
let compl = Fuzzy.original compl'
fullFilePath <- mkFilePathCompletion suffix compl complInfo
pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath
)

{- | Completer to be used when a directory can be completed for the field,
takes the file path of the directory to start from.
Only completes directories.
-}
directoryCompleter :: Completer
directoryCompleter recorder cData = do
let prefInfo = cabalPrefixInfo cData
complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo
directoryCompletions <- listDirectoryCompletions recorder complInfo
let scored =
Fuzzy.simpleFilter
1000
10
(partialFileName complInfo)
(map T.pack directoryCompletions)
forM
scored
( \compl' -> do
let compl = Fuzzy.original compl'
let fullDirPath = mkPathCompletion complInfo compl
pure $ mkCompletionItem (completionRange prefInfo) fullDirPath fullDirPath
)

{- Note [Using correct file path separators]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Expand Down Expand Up @@ -97,55 +144,6 @@ pathCompletionInfoFromCabalPrefixInfo ctx =
dirNamePrefix = T.pack $ Posix.takeFileName prefix
dir = completionWorkingDir ctx

{- | Extracts the source dirs from the library stanza in the cabal file using the GPD
and returns a list of path completions relative to any source dir which fit the passed prefix info.
-}
filePathsForExposedModules :: [FilePath] -> Recorder (WithPriority Log) -> CabalPrefixInfo -> IO [T.Text]
filePathsForExposedModules srcDirs recorder prefInfo = do
concatForM
srcDirs
(\dir -> do
let pInfo =
PathCompletionInfo
{ partialFileName = T.pack $ Posix.takeFileName prefix
, partialFileDir = Posix.addTrailingPathSeparator $ Posix.takeDirectory prefix
, workingDir = completionWorkingDir prefInfo FP.</> dir
}
completions <- listFileCompletions recorder pInfo
validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions
let filePathCompletions = map (fpToExposedModulePath dir) validExposedCompletions
toMatch = fromMaybe (partialFileName pInfo) $ T.stripPrefix "./" $ partialFileName pInfo
scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions)
forM
scored
( \compl' -> do
let compl = Fuzzy.original compl'
fullFilePath <- mkExposedModulePathCompletion compl pInfo
pure fullFilePath
)
)
where
prefix =
exposedModulePathToFp
$ completionPrefix prefInfo
isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool
isValidExposedModulePath pInfo path = do
let dir = mkCompletionDirectory pInfo
fileExists <- doesFileExist (dir FP.</> path)
pure $ not fileExists || FP.isExtensionOf ".hs" path

{- | Takes a source dir path and a cabal file path and returns the complete source dir
path in exposed module syntax where the separators are '.' and the file ending is removed.
-}
fpToExposedModulePath :: FilePath -> FilePath -> FilePath
fpToExposedModulePath srcDir cabalDir = T.unpack $ T.intercalate "." $ fmap T.pack $ FP.splitDirectories fp
where
fp = fromMaybe cabalDir $ stripPrefix srcDir cabalDir

{- | Takes a path in the exposed module field and translates it to a filepath.
-}
exposedModulePathToFp :: T.Text -> FilePath
exposedModulePathToFp fp = T.unpack $ T.replace "." (T.singleton FP.pathSeparator) fp

{- | Returns the directory, the currently handled cabal file is in.
Expand Down Expand Up @@ -191,16 +189,4 @@ mkFilePathCompletion suffix completion complInfo = do
let completedPath = if isFilePath then combinedPath ++ T.unpack suffix else combinedPath
pure $ T.pack completedPath

{- Takes a completed path and a pathCompletionInfo and generates the whole completed
filepath including the already written prefix using the cabal syntax for exposed modules.

i.e. Dir.Dir2.HaskellFile
or Dir.Dir2.
-}
mkExposedModulePathCompletion :: T.Text -> PathCompletionInfo -> IO T.Text
mkExposedModulePathCompletion completion complInfo = do
let combinedPath = T.unpack $ mkPathCompletion complInfo completion
isFilePath <- doesFileExist (workingDir complInfo FP.</> combinedPath)
let completedPath = T.pack $ if isFilePath then dropExtension combinedPath else combinedPath ++ "."
let exposedPath = fromMaybe completedPath $ T.stripPrefix "./" completedPath
pure $ T.pack $ fpToExposedModulePath "" $ T.unpack exposedPath
Loading

0 comments on commit f951657

Please sign in to comment.