Skip to content

Commit d0e77cc

Browse files
VenInfVenInf
committed
tests, formatting, other
1 parent 30b63da commit d0e77cc

File tree

5 files changed

+170
-134
lines changed

5 files changed

+170
-134
lines changed

‎haskell-language-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,7 @@ test-suite hls-cabal-plugin-tests
291291
Context
292292
Utils
293293
Outline
294+
CabalAdd
294295
build-depends:
295296
, base
296297
, bytestring

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -299,7 +299,7 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
299299
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
300300

301301
cabalAddCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
302-
cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
302+
cabalAddCodeAction recorder state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
303303
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
304304
let mbHaskellFilePath = uriToFilePath uri
305305
case mbHaskellFilePath of
@@ -310,12 +310,14 @@ cabalAddCodeAction recorder state plId (CodeActionParams _ _ docId@(TextDocument
310310
Nothing -> pure $ InL $ fmap InR [noCabalFileAction]
311311
Just cabalFilePath -> do
312312
verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
313-
mGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
314-
case mGPD of
313+
mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
314+
case mbGPD of
315315
Nothing -> pure $ InL []
316316
Just (gpd, _) -> do
317-
actions <- liftIO $ mapM (\diag -> CabalAdd.hiddenPackageAction cabalAddRecorder plId verTxtDocId
318-
maxCompls diag haskellFilePath cabalFilePath gpd) diags
317+
actions <- liftIO $ mapM (\diag ->
318+
CabalAdd.addDependencySuggestCodeAction cabalAddRecorder plId
319+
verTxtDocId maxCompls diag
320+
haskellFilePath cabalFilePath gpd) diags
319321
pure $ InL $ fmap InR (concat actions)
320322
where
321323
noCabalFileAction = CodeAction "No .cabal file found" (Just CodeActionKind_QuickFix) (Just []) Nothing

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/CabalAdd.hs

Lines changed: 34 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@
99

1010
module Ide.Plugin.Cabal.CabalAdd
1111
( findResponsibleCabalFile
12-
, hiddenPackageAction
12+
, addDependencySuggestCodeAction
1313
, hiddenPackageSuggestion
1414
, cabalAddCommand
1515
, command
@@ -99,13 +99,42 @@ instance Logger.Pretty Log where
9999
LogCreatedEdit edit -> "Created inplace edit:\n" Logger.<+> Logger.pretty edit
100100
LogExecutedCommand -> "Executed CabalAdd command"
101101

102+
cabalAddCommand :: IsString p => p
103+
cabalAddCommand = "cabalAdd"
104+
105+
data CabalAddCommandParams =
106+
CabalAddCommandParams { cabalPath :: FilePath
107+
, verTxtDocId :: VersionedTextDocumentIdentifier
108+
, buildTarget :: Maybe String
109+
, dependency :: T.Text
110+
, version :: Maybe T.Text
111+
}
112+
deriving (Generic, Show)
113+
deriving anyclass (FromJSON, ToJSON)
114+
115+
instance Logger.Pretty CabalAddCommandParams where
116+
pretty CabalAddCommandParams{..} =
117+
"CabalAdd parameters:\n" Logger.<+>
118+
"| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+>
119+
"| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+>
120+
"| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+>
121+
"| version: " Logger.<+> Logger.pretty version Logger.<+> "\n"
102122

103123
-- | Gives a code action that calls the command,
104124
-- if a suggestion for a missing dependency is found.
105125
-- Disabled action if no cabal files given.
106126
-- Conducts IO action on a cabal file to find build targets.
107-
hiddenPackageAction :: Logger.Recorder (Logger.WithPriority Log) -> PluginId -> VersionedTextDocumentIdentifier -> Int -> Diagnostic -> FilePath -> FilePath -> GenericPackageDescription -> IO [CodeAction]
108-
hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do
127+
addDependencySuggestCodeAction
128+
:: Logger.Recorder (Logger.WithPriority Log)
129+
-> PluginId
130+
-> VersionedTextDocumentIdentifier -- ^ Cabal's versioned text identifier
131+
-> Int -- ^ Maximum number of suggestions to return
132+
-> Diagnostic -- ^ Diagnostic from a code action
133+
-> FilePath -- ^ Path to the haskell file
134+
-> FilePath -- ^ Path to the cabal file
135+
-> GenericPackageDescription
136+
-> IO [CodeAction]
137+
addDependencySuggestCodeAction recorder plId verTxtDocId maxCompletions diag haskellFilePath cabalFilePath gpd = do
109138
buildTargets <- liftIO $ getBuildTargets gpd cabalFilePath haskellFilePath
110139
Logger.logWith recorder Logger.Info LogCalledCabalAddCodeAction
111140
case buildTargets of
@@ -138,8 +167,8 @@ hiddenPackageAction recorder plId verTxtDocId maxCompletions diag haskellFilePat
138167
command = mkLspCommand plId (CommandId cabalAddCommand) "Execute Code Action" (Just [toJSON params])
139168
in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing Nothing (Just command) Nothing
140169

141-
-- | Gives a mentioned number of hidden packages given
142-
-- a specific error message
170+
-- | Gives a mentioned number of @(dependency, version)@ pairs
171+
-- found in the "hidden package" message
143172
hiddenPackageSuggestion :: Int -> T.Text -> [(T.Text, T.Text)]
144173
hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg =~ regex)
145174
where
@@ -152,27 +181,6 @@ hiddenPackageSuggestion maxCompletions msg = take maxCompletions $ getMatch (msg
152181
getMatch (_, _, _, [dependency, _, cleanVersion]) = [(dependency, cleanVersion)]
153182
getMatch (_, _, _, _) = error "Impossible pattern matching case"
154183

155-
cabalAddCommand :: IsString p => p
156-
cabalAddCommand = "cabalAdd"
157-
158-
data CabalAddCommandParams =
159-
CabalAddCommandParams { cabalPath :: FilePath
160-
, verTxtDocId :: VersionedTextDocumentIdentifier
161-
, buildTarget :: Maybe String
162-
, dependency :: T.Text
163-
, version :: Maybe T.Text
164-
}
165-
deriving (Generic, Show)
166-
deriving anyclass (FromJSON, ToJSON)
167-
168-
instance Logger.Pretty CabalAddCommandParams where
169-
pretty CabalAddCommandParams{..} =
170-
"CabalAdd parameters:\n" Logger.<+>
171-
"| cabal path: " Logger.<+> Logger.pretty cabalPath Logger.<+> "\n" Logger.<+>
172-
"| target: " Logger.<+> Logger.pretty buildTarget Logger.<+> "\n" Logger.<+>
173-
"| dependendency: " Logger.<+> Logger.pretty dependency Logger.<+> "\n" Logger.<+>
174-
"| version: " Logger.<+> Logger.pretty version Logger.<+> "\n"
175-
176184
command :: Logger.Recorder (Logger.WithPriority Log) -> CommandFunction IdeState CabalAddCommandParams
177185
command recorder state _ params@(CabalAddCommandParams {cabalPath = path, verTxtDocId = verTxtDocId, buildTarget = target, dependency = dep, version = mbVer}) = do
178186
Logger.logWith recorder Logger.Info $ LogCalledCabalAddCommand params

‎plugins/hls-cabal-plugin/test/CabalAdd.hs

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module CabalAdd (
4+
cabalAddTests,
5+
) where
6+
7+
import Test.Hls
8+
import Control.Lens ((^.))
9+
import Control.Lens.Fold ((^?))
10+
import qualified Data.Text as T
11+
import qualified Data.Text.Internal.Search as T
12+
import qualified Language.LSP.Protocol.Lens as L
13+
import qualified Data.Maybe as Maybe
14+
import Distribution.Utils.Generic (safeHead)
15+
import System.FilePath
16+
import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion)
17+
import Utils
18+
19+
20+
cabalAddTests :: TestTree
21+
cabalAddTests =
22+
testGroup
23+
"CabalAdd Tests"
24+
[ runHaskellTestCaseSession "Code Actions - Can add hidden package" ("cabal-add-testdata" </> "cabal-add-exe")
25+
(generateAddDependencyTestSession "cabal-add-exe.cabal" ("src" </> "Main.hs") "split" [253])
26+
, runHaskellTestCaseSession "Code Actions - Can add hidden package to a library" ("cabal-add-testdata" </> "cabal-add-lib")
27+
(generateAddDependencyTestSession "cabal-add-lib.cabal" ("src" </> "MyLib.hs") "split" [348])
28+
, runHaskellTestCaseSession "Code Actions - Can add hidden package to a test" ("cabal-add-testdata" </> "cabal-add-tests")
29+
(generateAddDependencyTestSession "cabal-add-tests.cabal" ("test" </> "Main.hs") "split" [478])
30+
, runHaskellTestCaseSession "Code Actions - Can add hidden package to a benchmark" ("cabal-add-testdata" </> "cabal-add-bench")
31+
(generateAddDependencyTestSession "cabal-add-bench.cabal" ("bench" </> "Main.hs") "split" [403])
32+
, testHiddenPackageSuggestions "Check CabalAdd's parser, no version"
33+
[ "It is a member of the hidden package 'base'"
34+
, "It is a member of the hidden package 'Blammo-wai'"
35+
, "It is a member of the hidden package 'BlastHTTP'"
36+
, "It is a member of the hidden package 'CC-delcont-ref-tf'"
37+
, "It is a member of the hidden package '3d-graphics-examples'"
38+
, "It is a member of the hidden package 'AAI'"
39+
, "It is a member of the hidden package 'AWin32Console'"
40+
]
41+
[ ("base", T.empty)
42+
, ("Blammo-wai", T.empty)
43+
, ("BlastHTTP", T.empty)
44+
, ("CC-delcont-ref-tf", T.empty)
45+
, ("3d-graphics-examples", T.empty)
46+
, ("AAI", T.empty)
47+
, ("AWin32Console", T.empty)
48+
]
49+
, testHiddenPackageSuggestions "Check CabalAdd's parser, with version"
50+
[ "It is a member of the hidden package 'base-0.1.0.0'"
51+
, "It is a member of the hidden package 'Blammo-wai-0.11.0'"
52+
, "It is a member of the hidden package 'BlastHTTP-2.6.4.3'"
53+
, "It is a member of the hidden package 'CC-delcont-ref-tf-0.0.0.2'"
54+
, "It is a member of the hidden package '3d-graphics-examples-1.1.6'"
55+
, "It is a member of the hidden package 'AAI-0.1'"
56+
, "It is a member of the hidden package 'AWin32Console-1.19.1'"
57+
]
58+
[ ("base","0.1.0.0")
59+
, ("Blammo-wai", "0.11.0")
60+
, ("BlastHTTP", "2.6.4.3")
61+
, ("CC-delcont-ref-tf", "0.0.0.2")
62+
, ("3d-graphics-examples", "1.1.6")
63+
, ("AAI", "0.1")
64+
, ("AWin32Console", "1.19.1")
65+
]
66+
, testHiddenPackageSuggestions "Check CabalAdd's parser, no version, unicode comma"
67+
[ "It is a member of the hidden package \8216base\8217"
68+
, "It is a member of the hidden package \8216Blammo-wai\8217"
69+
, "It is a member of the hidden package \8216BlastHTTP\8217"
70+
, "It is a member of the hidden package \8216CC-delcont-ref-tf\8217"
71+
, "It is a member of the hidden package \8216AAI\8217"
72+
, "It is a member of the hidden package \8216AWin32Console\8217"
73+
]
74+
[ ("base", T.empty)
75+
, ("Blammo-wai", T.empty)
76+
, ("BlastHTTP", T.empty)
77+
, ("CC-delcont-ref-tf", T.empty)
78+
, ("AAI", T.empty)
79+
, ("AWin32Console", T.empty)
80+
]
81+
, testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma"
82+
[ "It is a member of the hidden package \8216base-0.1.0.0\8217"
83+
, "It is a member of the hidden package \8216Blammo-wai-0.11.0\8217"
84+
, "It is a member of the hidden package \8216BlastHTTP-2.6.4.3\8217"
85+
, "It is a member of the hidden package \8216CC-delcont-ref-tf-0.0.0.2\8217"
86+
, "It is a member of the hidden package \8216AAI-0.1\8217"
87+
, "It is a member of the hidden package \8216AWin32Console-1.19.1\8217"
88+
]
89+
[ ("base","0.1.0.0")
90+
, ("Blammo-wai", "0.11.0")
91+
, ("BlastHTTP", "2.6.4.3")
92+
, ("CC-delcont-ref-tf", "0.0.0.2")
93+
, ("AAI", "0.1")
94+
, ("AWin32Console", "1.19.1")
95+
]
96+
, expectFailBecause "TODO fix regex for these cases" $
97+
testHiddenPackageSuggestions "Check CabalAdd's parser, with version, unicode comma"
98+
[ "It is a member of the hidden package \82163d-graphics-examples\8217"
99+
, "It is a member of the hidden package \82163d-graphics-examples-1.1.6\8217"
100+
]
101+
[ ("3d-graphics-examples", T.empty)
102+
, ("3d-graphics-examples", "1.1.6")
103+
]
104+
]
105+
where
106+
generateAddDependencyTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session ()
107+
generateAddDependencyTestSession cabalFile haskellFile dependency indicesRes = do
108+
hsdoc <- openDoc haskellFile "haskell"
109+
cabDoc <- openDoc cabalFile "cabal"
110+
_ <- waitForDiagnosticsFrom hsdoc
111+
cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc
112+
let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas
113+
mapM_ executeCodeAction selectedCas
114+
_ <- skipManyTill anyMessage $ getDocumentEdit cabDoc -- Wait for the changes in cabal file
115+
contents <- documentContents cabDoc
116+
liftIO $ assertEqual (T.unpack dependency <> " isn't found in the cabal file") indicesRes (T.indices dependency contents)
117+
testHiddenPackageSuggestions :: String -> [T.Text] -> [(T.Text, T.Text)] -> TestTree
118+
testHiddenPackageSuggestions testTitle messages suggestions =
119+
let suggestions' = map (safeHead . hiddenPackageSuggestion 1) messages
120+
assertions = zipWith (@?=) suggestions' (map Just suggestions)
121+
testNames = map (\(f, s) -> "Check if " ++ T.unpack f ++ (if s == "" then "" else "-") ++ T.unpack s ++ " was parsed correctly") suggestions
122+
test = testGroup testTitle $ zipWith testCase testNames assertions
123+
in test

0 commit comments

Comments
 (0)