33module Ide.Plugin.Cabal.Completion.Completer.Module where
44
55import qualified Data.List as List
6- import Data.Maybe (fromJust ,
7- fromMaybe )
6+ import Data.Maybe (fromMaybe )
87import qualified Data.Text as T
98import Development.IDE (IdeState (shakeExtras ))
109import Development.IDE.Core.Shake (runIdeAction ,
@@ -15,11 +14,14 @@ import Distribution.PackageDescription (Benchmark (..),
1514 Executable (.. ),
1615 GenericPackageDescription (.. ),
1716 Library (.. ),
18- TestSuite ( testName ) ,
17+ UnqualComponentName ,
1918 mkUnqualComponentName ,
2019 testBuildInfo )
2120import Distribution.Utils.Path (getSymbolicPath )
22- import Ide.Plugin.Cabal.Completion.Completer.FilePath
21+ import Ide.Plugin.Cabal.Completion.Completer.FilePath (PathCompletionInfo (.. ),
22+ listFileCompletions ,
23+ mkCompletionDirectory ,
24+ mkPathCompletion )
2325import Ide.Plugin.Cabal.Completion.Completer.Types
2426import Ide.Plugin.Cabal.Completion.Types
2527
@@ -33,15 +35,18 @@ import System.Directory (doesFileExist)
3335import qualified System.FilePath as FP
3436import qualified System.FilePath.Posix as Posix
3537import qualified Text.Fuzzy.Parallel as Fuzzy
38+
3639{- | Completer to be used when module paths can be completed for the field.
3740
3841 Takes an extraction function which extracts the source directories
3942 to be used by the completer.
4043-}
4144modulesCompleter :: (GenericPackageDescription -> [FilePath ]) -> Completer
4245modulesCompleter extractionFunction recorder cData = do
43- maybeGpd <- runIdeAction " cabal-plugin.modulesCompleter.parseCabal" extras
44- $ useWithStaleFast ParseCabal $ normalizedCabalFilePath prefInfo
46+ maybeGpd <-
47+ runIdeAction " cabal-plugin.modulesCompleter.parseCabal" extras $
48+ useWithStaleFast ParseCabal $
49+ normalizedCabalFilePath prefInfo
4550 case maybeGpd of
4651 Just (gpd, _) -> do
4752 let sourceDirs = extractionFunction gpd
@@ -50,114 +55,91 @@ modulesCompleter extractionFunction recorder cData = do
5055 Nothing -> do
5156 logWith recorder Debug LogUseWithStaleFastNoResult
5257 pure []
53- where
54- extras = shakeExtras (ideState cData)
55- prefInfo = cabalPrefixInfo cData
58+ where
59+ extras = shakeExtras (ideState cData)
60+ prefInfo = cabalPrefixInfo cData
5661
57- {- | Extracts the source directories of the library stanza.
58- -}
59- sourceDirsExtractionLibrary :: GenericPackageDescription -> [FilePath ]
60- sourceDirsExtractionLibrary gpd =
62+ -- | Extracts the source directories of the library stanza.
63+ sourceDirsExtractionLibrary :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
64+ sourceDirsExtractionLibrary Nothing gpd =
6165 -- we use condLibrary to get the information contained in the library stanza
6266 -- since the library in PackageDescription is not populated by us
6367 case libM of
6468 Just lib -> do
6569 map getSymbolicPath $ hsSourceDirs $ libBuildInfo $ condTreeData lib
6670 Nothing -> []
67- where
68- libM = condLibrary gpd
71+ where
72+ libM = condLibrary gpd
73+ sourceDirsExtractionLibrary name gpd = extractRelativeDirsFromStanza name gpd condSubLibraries libBuildInfo
6974
70- {- | Extracts the source directories of the executable stanza with the given name.
71- -}
75+ -- | Extracts the source directories of the executable stanza with the given name.
7276sourceDirsExtractionExecutable :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
73- sourceDirsExtractionExecutable Nothing _ = []
74- sourceDirsExtractionExecutable (Just name) gpd
75- | exeName executable == (mkUnqualComponentName $ T. unpack name) = map getSymbolicPath $ hsSourceDirs $ buildInfo executable
76- | otherwise = []
77- where
78- executable = condTreeData $ snd $ fromJust res
79- execsM = condExecutables gpd
80- res =
81- List. find
82- (\ (_, cTree) -> do
83- let execName = exeName $ condTreeData cTree
84- execName == (mkUnqualComponentName $ T. unpack name)
85- )
86- execsM
77+ sourceDirsExtractionExecutable name gpd = extractRelativeDirsFromStanza name gpd condExecutables buildInfo
8778
88- {- | Extracts the source directories of the test suite stanza with the given name.
89- -}
90- sourceDirsExtractionTestSuite :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
91- sourceDirsExtractionTestSuite Nothing _ = []
92- sourceDirsExtractionTestSuite (Just name) gpd
93- | testName testSuite == (mkUnqualComponentName $ T. unpack name) = map getSymbolicPath $ hsSourceDirs $ testBuildInfo testSuite
94- | otherwise = []
95- where
96- testSuite = condTreeData $ snd $ fromJust res
97- testSuitesM = condTestSuites gpd
98- res =
99- List. find
100- (\ (_, cTree) -> do
101- let testsName = testName $ condTreeData cTree
102- testsName == (mkUnqualComponentName $ T. unpack name)
103- )
104- testSuitesM
79+ -- | Extracts the source directories of the test suite stanza with the given name.
80+ sourceDirsExtractionTestSuite :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
81+ sourceDirsExtractionTestSuite name gpd = extractRelativeDirsFromStanza name gpd condTestSuites testBuildInfo
10582
106- {- | Extracts the source directories of benchmark stanza with the given name.
107- -}
108- sourceDirsExtractionBenchmark :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
109- sourceDirsExtractionBenchmark Nothing _ = []
110- sourceDirsExtractionBenchmark (Just name) gpd
111- | benchmarkName bMark == (mkUnqualComponentName $ T. unpack name) = map getSymbolicPath $ hsSourceDirs $ benchmarkBuildInfo bMark
83+ -- | Extracts the source directories of benchmark stanza with the given name.
84+ sourceDirsExtractionBenchmark :: Maybe T. Text -> GenericPackageDescription -> [FilePath ]
85+ sourceDirsExtractionBenchmark name gpd = extractRelativeDirsFromStanza name gpd condBenchmarks benchmarkBuildInfo
86+
87+ extractRelativeDirsFromStanza ::
88+ Maybe T. Text ->
89+ GenericPackageDescription ->
90+ (GenericPackageDescription -> [(UnqualComponentName , CondTree b c a )]) ->
91+ (a -> BuildInfo ) ->
92+ [FilePath ]
93+ extractRelativeDirsFromStanza Nothing _ _ _ = []
94+ extractRelativeDirsFromStanza (Just name) gpd getStanza getBuildInfo
95+ | Just stanza <- stanzaM = map getSymbolicPath $ hsSourceDirs $ getBuildInfo stanza
11296 | otherwise = []
113- where
114- bMark = condTreeData $ snd $ fromJust res
115- bMarksM = condBenchmarks gpd
116- res =
117- List. find
118- (\ (_, cTree) -> do
119- let bMarkName = benchmarkName $ condTreeData cTree
120- bMarkName == (mkUnqualComponentName $ T. unpack name)
121- )
122- bMarksM
97+ where
98+ stanzaM = fmap (condTreeData . snd ) res
99+ allStanzasM = getStanza gpd
100+ res =
101+ List. find
102+ ( \ (n, _) ->
103+ n == (mkUnqualComponentName $ T. unpack name)
104+ )
105+ allStanzasM
123106
124107{- | Extracts the source dirs from the library stanza in the cabal file using the GPD
125108 and returns a list of path completions relative to any source dir which fit the passed prefix info.
126109-}
127110filePathsForExposedModules :: [FilePath ] -> Recorder (WithPriority Log ) -> CabalPrefixInfo -> IO [T. Text ]
128111filePathsForExposedModules srcDirs recorder prefInfo = do
129- concatForM
130- srcDirs
131- ( \ dir -> do
132- let pInfo =
133- PathCompletionInfo
112+ concatForM
113+ srcDirs
114+ ( \ dir -> do
115+ let pInfo =
116+ PathCompletionInfo
134117 { partialFileName = T. pack $ Posix. takeFileName prefix
135- , partialFileDir = Posix. addTrailingPathSeparator $ Posix. takeDirectory prefix
118+ , partialFileDir = Posix. addTrailingPathSeparator $ Posix. takeDirectory prefix
136119 , workingDir = completionWorkingDir prefInfo FP. </> dir
137120 }
138- completions <- listFileCompletions recorder pInfo
139- validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions
140- let filePathCompletions = map (fpToExposedModulePath dir) validExposedCompletions
141- toMatch = fromMaybe (partialFileName pInfo) $ T. stripPrefix " ./" $ partialFileName pInfo
142- scored = Fuzzy. simpleFilter 1000 10 toMatch (map T. pack filePathCompletions)
143- forM
144- scored
145- ( \ compl' -> do
146- let compl = Fuzzy. original compl'
147- fullFilePath <- mkExposedModulePathCompletion compl pInfo
148- pure fullFilePath
149- )
150- )
151- where
152- prefix =
153- exposedModulePathToFp
154- $ completionPrefix prefInfo
155- isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool
156- isValidExposedModulePath pInfo path = do
157- let dir = mkCompletionDirectory pInfo
158- fileExists <- doesFileExist (dir FP. </> path)
159- pure $ not fileExists || FP. isExtensionOf " .hs" path
160-
121+ completions <- listFileCompletions recorder pInfo
122+ validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions
123+ let filePathCompletions = map (fpToExposedModulePath dir) validExposedCompletions
124+ toMatch = fromMaybe (partialFileName pInfo) $ T. stripPrefix " ./" $ partialFileName pInfo
125+ scored = Fuzzy. simpleFilter 1000 10 toMatch (map T. pack filePathCompletions)
126+ forM
127+ scored
128+ ( \ compl' -> do
129+ let compl = Fuzzy. original compl'
130+ fullFilePath <- mkExposedModulePathCompletion compl pInfo
131+ pure fullFilePath
132+ )
133+ )
134+ where
135+ prefix =
136+ exposedModulePathToFp $
137+ completionPrefix prefInfo
138+ isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool
139+ isValidExposedModulePath pInfo path = do
140+ let dir = mkCompletionDirectory pInfo
141+ fileExists <- doesFileExist (dir FP. </> path)
142+ pure $ not fileExists || FP. isExtensionOf " .hs" path
161143
162144{- Takes a completed path and a pathCompletionInfo and generates the whole completed
163145 filepath including the already written prefix using the cabal syntax for exposed modules.
@@ -177,11 +159,10 @@ mkExposedModulePathCompletion completion complInfo = do
177159 path in exposed module syntax where the separators are '.' and the file ending is removed.
178160-}
179161fpToExposedModulePath :: FilePath -> FilePath -> FilePath
180- fpToExposedModulePath srcDir cabalDir = T. unpack $ T. intercalate " ." $ fmap T. pack $ FP. splitDirectories fp
181- where
182- fp = fromMaybe cabalDir $ stripPrefix srcDir cabalDir
162+ fpToExposedModulePath srcDir cabalDir = T. unpack $ T. intercalate " ." $ fmap T. pack $ FP. splitDirectories fp
163+ where
164+ fp = fromMaybe cabalDir $ stripPrefix srcDir cabalDir
183165
184- {- | Takes a path in the exposed module field and translates it to a filepath.
185- -}
166+ -- | Takes a path in the exposed module field and translates it to a filepath.
186167exposedModulePathToFp :: T. Text -> FilePath
187168exposedModulePathToFp fp = T. unpack $ T. replace " ." (T. singleton FP. pathSeparator) fp
0 commit comments