Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit afe8ba8

Browse files
lukel97lukel97
committed
Remove CommandFunc/CmdSync
1 parent aa0f0c5 commit afe8ba8

File tree

13 files changed

+51
-79
lines changed

13 files changed

+51
-79
lines changed

‎hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@ module Haskell.Ide.Engine.PluginsIdeMonads
2929
, PluginDescriptor(..)
3030
, pluginDescToIdePlugins
3131
, PluginCommand(..)
32-
, CommandFunc(..)
3332
, runPluginCommand
3433
, DynamicJSON
3534
, dynToJSON
@@ -279,12 +278,10 @@ instance Show PluginCommand where
279278
type PluginId = T.Text
280279
type CommandName = T.Text
281280

282-
newtype CommandFunc a b = CmdSync (a -> IdeGhcM (IdeResult b))
283-
284281
data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>
285282
PluginCommand { commandName :: CommandName
286283
, commandDesc :: T.Text
287-
, commandFunc :: CommandFunc a b
284+
, commandFunc :: a -> IdeGhcM (IdeResult b)
288285
}
289286

290287
pluginDescToIdePlugins :: [PluginDescriptor] -> IdePlugins
@@ -313,7 +310,7 @@ runPluginCommand p com arg = do
313310
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandName) xs of
314311
Nothing -> return $ IdeResultFail $
315312
IdeError UnknownCommand ("Command " <> com <> " isn't defined for plugin " <> p <> ". Legal commands are: " <> T.pack(show $ map commandName xs)) Null
316-
Just (PluginCommand _ _ (CmdSync f)) -> case fromJSON arg of
313+
Just (PluginCommand _ _ f) -> case fromJSON arg of
317314
Error err -> return $ IdeResultFail $
318315
IdeError ParameterError ("error while parsing args for " <> com <> " in plugin " <> p <> ": " <> T.pack err) Null
319316
Success a -> do

‎src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs

Lines changed: 12 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ applyRefactDescriptor plId = PluginDescriptor
4646
, pluginCommands =
4747
[ PluginCommand "applyOne" "Apply a single hint" applyOneCmd
4848
, PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd
49-
, PluginCommand "lint" "Run hlint on the file to generate hints" lintCmd
5049
]
5150
, pluginCodeActionProvider = Just codeActionProvider
5251
, pluginDiagnosticProvider = Nothing
@@ -69,12 +68,9 @@ data OneHint = OneHint
6968
, oneHintTitle :: HintTitle
7069
} deriving (Eq, Show)
7170

72-
applyOneCmd :: CommandFunc ApplyOneParams WorkspaceEdit
73-
applyOneCmd = CmdSync $ \(AOP uri pos title) -> do
74-
applyOneCmd' uri (OneHint pos title)
75-
76-
applyOneCmd' :: Uri -> OneHint -> IdeGhcM (IdeResult WorkspaceEdit)
77-
applyOneCmd' uri oneHint = pluginGetFile "applyOne: " uri $ \fp -> do
71+
applyOneCmd :: ApplyOneParams -> IdeGhcM (IdeResult WorkspaceEdit)
72+
applyOneCmd (AOP uri pos title) = pluginGetFile "applyOne: " uri $ \fp -> do
73+
let oneHint = OneHint pos title
7874
revMapp <- reverseFileMap
7975
let defaultResult = do
8076
debugm "applyOne: no access to the persisted file."
@@ -91,12 +87,8 @@ applyOneCmd' uri oneHint = pluginGetFile "applyOne: " uri $ \fp -> do
9187

9288
-- ---------------------------------------------------------------------
9389

94-
applyAllCmd :: CommandFunc Uri WorkspaceEdit
95-
applyAllCmd = CmdSync $ \uri -> do
96-
applyAllCmd' uri
97-
98-
applyAllCmd' :: Uri -> IdeGhcM (IdeResult WorkspaceEdit)
99-
applyAllCmd' uri = pluginGetFile "applyAll: " uri $ \fp -> do
90+
applyAllCmd :: Uri -> IdeGhcM (IdeResult WorkspaceEdit)
91+
applyAllCmd uri = pluginGetFile "applyAll: " uri $ \fp -> do
10092
let defaultResult = do
10193
debugm "applyAll: no access to the persisted file."
10294
return $ IdeResultOk mempty
@@ -111,26 +103,22 @@ applyAllCmd' uri = pluginGetFile "applyAll: " uri $ \fp -> do
111103

112104
-- ---------------------------------------------------------------------
113105

114-
lintCmd :: CommandFunc Uri PublishDiagnosticsParams
115-
lintCmd = CmdSync $ \uri -> do
116-
lintCmd' uri
117-
118106
-- AZ:TODO: Why is this in IdeGhcM?
119-
lintCmd' :: Uri -> IdeGhcM (IdeResult PublishDiagnosticsParams)
120-
lintCmd' uri = pluginGetFile "lintCmd: " uri $ \fp -> do
107+
lint :: Uri -> IdeGhcM (IdeResult PublishDiagnosticsParams)
108+
lint uri = pluginGetFile "lint: " uri $ \fp -> do
121109
let
122110
defaultResult = do
123-
debugm "lintCmd: no access to the persisted file."
111+
debugm "lint: no access to the persisted file."
124112
return
125113
$ IdeResultOk (PublishDiagnosticsParams (filePathToUri fp) $ List [])
126114
withMappedFile fp defaultResult $ \file' -> do
127115
eitherErrorResult <- liftIO
128-
(try $ runExceptT $ runLintCmd file' [] :: IO
116+
(try $ runExceptT $ runLint file' [] :: IO
129117
(Either IOException (Either [Diagnostic] [Idea]))
130118
)
131119
case eitherErrorResult of
132120
Left err -> return $ IdeResultFail
133-
(IdeError PluginError (T.pack $ "lintCmd: " ++ show err) Null)
121+
(IdeError PluginError (T.pack $ "lint: " ++ show err) Null)
134122
Right res -> case res of
135123
Left diags ->
136124
return
@@ -143,8 +131,8 @@ lintCmd' uri = pluginGetFile "lintCmd: " uri $ \fp -> do
143131
$ PublishDiagnosticsParams (filePathToUri fp)
144132
$ List (map hintToDiagnostic $ stripIgnores fs)
145133

146-
runLintCmd :: FilePath -> [String] -> ExceptT [Diagnostic] IO [Idea]
147-
runLintCmd fp args = do
134+
runLint :: FilePath -> [String] -> ExceptT [Diagnostic] IO [Idea]
135+
runLint fp args = do
148136
(flags,classify,hint) <- liftIO $ argsSettings args
149137
let myflags = flags { hseFlags = (hseFlags flags) { extensions = EnableExtension TypeApplications:extensions (hseFlags flags)}}
150138
res <- bimapExceptT parseErrorToDiagnostic id $ ExceptT $ parseModuleEx myflags fp Nothing

‎src/Haskell/Ide/Engine/Plugin/Bios.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ biosDescriptor plId = PluginDescriptor
2626
, pluginFormattingProvider = Nothing
2727
}
2828

29-
checkCmd :: CommandFunc Uri (Diagnostics, AdditionalErrs)
30-
checkCmd = CmdSync setTypecheckedModule
29+
checkCmd :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs))
30+
checkCmd = setTypecheckedModule
3131

3232
-- ---------------------------------------------------------------------

‎src/Haskell/Ide/Engine/Plugin/Example2.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,11 @@ example2Descriptor plId = PluginDescriptor
3939

4040
-- ---------------------------------------------------------------------
4141

42-
sayHelloCmd :: CommandFunc () T.Text
43-
sayHelloCmd = CmdSync $ \_ -> return (IdeResultOk sayHello)
42+
sayHelloCmd :: () -> IdeGhcM (IdeResult T.Text)
43+
sayHelloCmd () = return (IdeResultOk sayHello)
4444

45-
sayHelloToCmd :: CommandFunc T.Text T.Text
46-
sayHelloToCmd = CmdSync $ \n -> do
45+
sayHelloToCmd :: T.Text -> IdeGhcM (IdeResult T.Text)
46+
sayHelloToCmd n = do
4747
r <- liftIO $ sayHelloTo n
4848
return $ IdeResultOk r
4949

@@ -78,8 +78,8 @@ data TodoParams = TodoParams
7878
}
7979
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
8080

81-
todoCmd :: CommandFunc TodoParams J.WorkspaceEdit
82-
todoCmd = CmdSync $ \(TodoParams uri r) -> return $ IdeResultOk $ makeTodo uri r
81+
todoCmd :: TodoParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
82+
todoCmd (TodoParams uri r) = return $ IdeResultOk $ makeTodo uri r
8383

8484
makeTodo :: J.Uri -> J.Range -> J.WorkspaceEdit
8585
makeTodo uri (J.Range (J.Position startLine _) _) = res

‎src/Haskell/Ide/Engine/Plugin/Generic.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -66,15 +66,14 @@ instance FromJSON TypeParams where
6666
instance ToJSON TypeParams where
6767
toJSON = genericToJSON customOptions
6868

69-
typeCmd :: CommandFunc TypeParams [(Range,T.Text)]
70-
typeCmd = CmdSync $ \(TP _bool uri pos) ->
71-
liftToGhc $ newTypeCmd pos uri
69+
typeCmd :: TypeParams -> IdeGhcM (IdeResult [(Range,T.Text)])
70+
typeCmd (TP _bool uri pos) = liftToGhc $ newTypeCmd pos uri
7271

7372
newTypeCmd :: Position -> Uri -> IdeM (IdeResult [(Range, T.Text)])
7473
newTypeCmd newPos uri =
7574
pluginGetFile "newTypeCmd: " uri $ \fp ->
7675
ifCachedModule fp (IdeResultOk []) $ \tm info -> do
77-
debugm $ "newTypeCmd: " <> (show (newPos, uri))
76+
debugm $ "newTypeCmd: " <> show (newPos, uri)
7877
return $ IdeResultOk $ pureTypeCmd newPos tm info
7978

8079
pureTypeCmd :: Position -> GHC.TypecheckedModule -> CachedInfo -> [(Range,T.Text)]

‎src/Haskell/Ide/Engine/Plugin/HfaAlign.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -48,8 +48,8 @@ data AlignParams = AlignParams
4848
}
4949
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
5050

51-
alignCmd :: CommandFunc AlignParams J.WorkspaceEdit
52-
alignCmd = CmdSync $ \(AlignParams uri rg) -> do
51+
alignCmd :: AlignParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
52+
alignCmd (AlignParams uri rg) = do
5353
mtext <- getRangeFromVFS uri rg
5454
case mtext of
5555
Nothing -> return $ IdeResultOk $ J.WorkspaceEdit Nothing Nothing

‎src/Haskell/Ide/Engine/Plugin/HsImport.hs

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ hsimportDescriptor plId = PluginDescriptor
3333
{ pluginId = plId
3434
, pluginName = "HsImport"
3535
, pluginDesc = "A tool for extending the import list of a Haskell source file."
36-
, pluginCommands = [PluginCommand "import" "Import a module" importCmd]
36+
, pluginCommands = [PluginCommand "import" "Import a module" importModule]
3737
, pluginCodeActionProvider = Just codeActionProvider
3838
, pluginDiagnosticProvider = Nothing
3939
, pluginHoverProvider = Nothing
@@ -114,18 +114,13 @@ data ImportParams = ImportParams
114114
}
115115
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
116116

117-
importCmd :: CommandFunc ImportParams J.WorkspaceEdit
118-
importCmd = CmdSync $ \(ImportParams uri style modName) ->
119-
importModule uri style modName
120-
121117
-- | Import the given module for the given file.
122118
-- May take an explicit function name to perform an import-list import.
123119
-- Multiple import-list imports will result in merged imports,
124120
-- e.g. two consecutive imports for the same module will result in a single
125121
-- import line.
126-
importModule
127-
:: Uri -> ImportStyle -> ModuleName -> IdeGhcM (IdeResult J.WorkspaceEdit)
128-
importModule uri impStyle modName =
122+
importModule :: ImportParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
123+
importModule (ImportParams uri impStyle modName) =
129124
pluginGetFile "hsimport cmd: " uri $ \origInput -> do
130125
shouldFormat <- formatOnImportOn <$> getConfig
131126
fileMap <- reverseFileMap

‎src/Haskell/Ide/Engine/Plugin/Package.hs

Lines changed: 2 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -87,15 +87,8 @@ type Package = T.Text
8787
-- May fail if no project dependency specification can be found.
8888
-- Supported are `*.cabal` and `package.yaml` specifications.
8989
-- Moreover, may fail with an IOException in case of a filesystem problem.
90-
addCmd :: CommandFunc AddParams J.WorkspaceEdit
91-
addCmd = CmdSync addCmd'
92-
93-
-- | Add a package to the project's dependencies.
94-
-- May fail if no project dependency specification can be found.
95-
-- Supported are `*.cabal` and `package.yaml` specifications.
96-
-- Moreover, may fail with an IOException in case of a filesystem problem.
97-
addCmd' :: AddParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
98-
addCmd' (AddParams rootDir modulePath pkg) = do
90+
addCmd :: AddParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
91+
addCmd (AddParams rootDir modulePath pkg) = do
9992
packageType <- liftIO $ findPackageType rootDir
10093
fileMap <- reverseFileMap
10194

‎src/Haskell/Ide/Engine/Plugin/Pragmas.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -43,8 +43,8 @@ data AddPragmaParams = AddPragmaParams
4343
-- Pragma is added to the first line of the Uri.
4444
-- It is assumed that the pragma name is a valid pragma,
4545
-- thus, not validated.
46-
addPragmaCmd :: CommandFunc AddPragmaParams J.WorkspaceEdit
47-
addPragmaCmd = CmdSync $ \(AddPragmaParams uri pragmaName) -> do
46+
addPragmaCmd :: AddPragmaParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
47+
addPragmaCmd (AddPragmaParams uri pragmaName) = do
4848
let
4949
pos = J.Position 0 0
5050
textEdits = J.List

‎src/Haskell/Ide/Engine/Server.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -920,7 +920,7 @@ requestDiagnosticsNormal tn file mVer = do
920920
when sendHlint $ do
921921
-- get hlint diagnostics
922922
let reql = GReq tn "apply-refact" (Just file) (Just (file,ver)) Nothing callbackl (PublishDiagnosticsParams file mempty)
923-
$ ApplyRefact.lintCmd' file
923+
$ ApplyRefact.lint file
924924
callbackl (PublishDiagnosticsParams fp (List ds))
925925
= sendOne "hlint" (J.toNormalizedUri fp, ds)
926926
makeRequest reql

‎test/unit/ApplyRefactPluginSpec.hs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ applyRefactSpec = do
4242
it "applies one hint only" $ do
4343

4444
let furi = applyRefactPath
45-
act = applyOneCmd' furi (OneHint (toPos (2,8)) "Redundant bracket")
45+
act = applyOneCmd arg
4646
arg = AOP furi (toPos (2,8)) "Redundant bracket"
4747
textEdits = List [TextEdit (Range (Position 1 0) (Position 1 25)) "main = putStrLn \"hello\""]
4848
res = IdeResultOk $ WorkspaceEdit
@@ -54,7 +54,7 @@ applyRefactSpec = do
5454

5555
it "applies all hints" $ do
5656

57-
let act = applyAllCmd' arg
57+
let act = applyAllCmd arg
5858
arg = applyRefactPath
5959
textEdits = List [ TextEdit (Range (Position 1 0) (Position 1 25)) "main = putStrLn \"hello\""
6060
, TextEdit (Range (Position 3 0) (Position 3 15)) "foo x = x + 1" ]
@@ -67,7 +67,7 @@ applyRefactSpec = do
6767

6868
it "returns hints as diagnostics" $ do
6969

70-
let act = lintCmd' arg
70+
let act = lint arg
7171
arg = applyRefactPath
7272
res = IdeResultOk
7373
PublishDiagnosticsParams
@@ -94,7 +94,7 @@ applyRefactSpec = do
9494
filePathNoUri <- makeAbsolute "./test/testdata/HlintParseFail.hs"
9595
let filePath = filePathToUri filePathNoUri
9696

97-
let act = lintCmd' arg
97+
let act = lint arg
9898
arg = filePath
9999
res = IdeResultOk
100100
PublishDiagnosticsParams
@@ -114,7 +114,7 @@ applyRefactSpec = do
114114
it "respects hlint pragmas in the source file" $ do
115115
filePath <- filePathToUri <$> makeAbsolute "./test/testdata/HlintPragma.hs"
116116

117-
let req = lintCmd' filePath
117+
let req = lint filePath
118118
r <- runIGM testPlugins req
119119
r `shouldBe`
120120
(IdeResultOk
@@ -136,7 +136,7 @@ applyRefactSpec = do
136136
it "respects hlint config files in project root dir" $ do
137137
filePath <- filePathToUri <$> makeAbsolute "./test/testdata/HlintPragma.hs"
138138

139-
let req = lintCmd' filePath
139+
let req = lint filePath
140140
r <- withCurrentDirectory "./test/testdata" $ runIGM testPlugins req
141141
r `shouldBe`
142142
(IdeResultOk
@@ -152,7 +152,7 @@ applyRefactSpec = do
152152
it "reports error without crash" $ do
153153
filePath <- filePathToUri <$> makeAbsolute "./test/testdata/ApplyRefactError.hs"
154154

155-
let req = applyAllCmd' filePath
155+
let req = applyAllCmd filePath
156156
isExpectedError (IdeResultFail (IdeError PluginError err _)) =
157157
"Illegal symbol '.' in type" `T.isInfixOf` err
158158
isExpectedError _ = False

‎test/unit/ExtensibleStateSpec.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,13 +50,13 @@ testDescriptor plId = PluginDescriptor
5050

5151
-- ---------------------------------------------------------------------
5252

53-
cmd1 :: CommandFunc () T.Text
54-
cmd1 = CmdSync $ \_ -> do
53+
cmd1 :: () -> IdeGhcM (IdeResult T.Text)
54+
cmd1 () = do
5555
put (MS1 "foo")
5656
return (IdeResultOk (T.pack "result:put foo"))
5757

58-
cmd2 :: CommandFunc () T.Text
59-
cmd2 = CmdSync $ \_ -> do
58+
cmd2 :: () -> IdeGhcM (IdeResult T.Text)
59+
cmd2 () = do
6060
(MS1 v) <- get
6161
return (IdeResultOk (T.pack $ "result:got:" ++ show v))
6262

‎test/unit/PackagePluginSpec.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ packageSpec = do
6262
fp = cwd </> testdata </> "cabal-exe"
6363
uri = filePathToUri $ fp </> "add-package-test.cabal"
6464
args = AddParams fp (fp </> "AddPackage.hs") "text"
65-
act = addCmd' args
65+
act = addCmd args
6666
textEdits =
6767
List
6868
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
@@ -95,7 +95,7 @@ packageSpec = do
9595
fp = cwd </> testdata </> "cabal-lib"
9696
uri = filePathToUri $ fp </> "add-package-test.cabal"
9797
args = AddParams fp (fp </> "AddPackage.hs") "text"
98-
act = addCmd' args
98+
act = addCmd args
9999
textEdits =
100100
List
101101
[ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat
@@ -130,7 +130,7 @@ packageSpec = do
130130
fp = cwd </> testdata </> "hpack-exe"
131131
uri = filePathToUri $ fp </> "package.yaml"
132132
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
133-
act = addCmd' args
133+
act = addCmd args
134134
res = IdeResultOk
135135
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
136136
textEdits = List
@@ -168,7 +168,7 @@ packageSpec = do
168168
fp = cwd </> testdata </> "hpack-lib"
169169
uri = filePathToUri $ fp </> "package.yaml"
170170
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
171-
act = addCmd' args
171+
act = addCmd args
172172
res = IdeResultOk
173173
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
174174
textEdits =
@@ -200,7 +200,7 @@ packageSpec = do
200200
let
201201
fp = cwd </> testdata </> "invalid"
202202
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
203-
act = addCmd' args
203+
act = addCmd args
204204
res =
205205
IdeResultFail
206206
(IdeError PluginError

0 commit comments

Comments
 (0)