diff --git a/app/RunTest.hs b/app/RunTest.hs
index 4478d7df5..26df98b80 100644
--- a/app/RunTest.hs
+++ b/app/RunTest.hs
@@ -103,8 +103,8 @@ runServer mlibdir ideplugins targets = do
prettyPrintDiags
:: FilePath -> IdeResult (Ghc.Diagnostics, Ghc.AdditionalErrs) -> T.Text
prettyPrintDiags fp diags = T.pack fp <> ": " <> case diags of
- IdeResultFail IdeError { ideMessage } -> "FAILED\n\t" <> ideMessage
- IdeResultOk (_diags, errs) ->
+ Left IdeError { ideMessage } -> "FAILED\n\t" <> ideMessage
+ Right (_diags, errs) ->
if null errs then "OK" else T.unlines (map (T.append "\t") errs)
-- ---------------------------------------------------------------------
diff --git a/docs/Architecture.md b/docs/Architecture.md
index 07457646f..d9ad85482 100644
--- a/docs/Architecture.md
+++ b/docs/Architecture.md
@@ -188,7 +188,7 @@ If there is no cached module available, then it will automatically defer your re
or return a default if that then fails to typecheck:
```haskell
-withCachedModule file (IdeResultOk []) $ \cm -> do
+withCachedModule file (Right []) $ \cm -> do
-- poke about with cm here
```
diff --git a/docs/Dispatch.md b/docs/Dispatch.md
index abc149f99..f122a9cd6 100644
--- a/docs/Dispatch.md
+++ b/docs/Dispatch.md
@@ -29,10 +29,10 @@
| IdeResult |
| + + |
| v | |
- | IdeResultFail | |
- | v |
- | IdeResultOk |
- | + |
+ | IdeError | |
+ | | |
+ | | |
+ | | |
| v |
| RequestCallback |
v + v
diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
index e40514b30..35b719285 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
@@ -245,7 +245,7 @@ setTypecheckedModule_load uri =
debugm "setTypecheckedModule: before ghc-mod"
debugm "Loading file"
getPersistedFile uri >>= \case
- Nothing -> return $ IdeResultOk (Diagnostics mempty, [])
+ Nothing -> return $ Right (Diagnostics mempty, [])
Just mapped_fp -> do
liftIO $ copyHsBoot fp mapped_fp
rfm <- reverseFileMap
@@ -292,7 +292,7 @@ setTypecheckedModule_load uri =
in Map.insertWith Set.union canonUri (Set.singleton d) diags
Just {} -> diags
- return $ IdeResultOk (Diagnostics diags2,errs)
+ return $ Right (Diagnostics diags2,errs)
{-
diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
index de81fc745..2279bf57a 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
@@ -32,7 +32,6 @@ import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Free
-import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as B
import Data.Dynamic (toDyn, fromDynamic, Dynamic)
import Data.Generics (Proxy(..), TypeRep, typeRep, typeOf)
@@ -85,7 +84,7 @@ type PublishDiagnostics = J.NormalizedUri -> J.TextDocumentVersion -> J.Diagnost
--
-- There are three possibilities for loading a cradle
-- 1. Load succeeds and we get a new cradle to execute the action in
--- 2. Load fails, so we report an error using IdeResultFail
+-- 2. Load fails, so we report an error using ideRrror
-- 3. The bios reports CradleNone, which means we should completely ignore
-- the file.
--
@@ -107,7 +106,7 @@ runActionWithContext _pub _df Nothing _def action =
--This causes problems when loading a later package which sets the
--packageDb
-- loadCradle df (Bios.defaultCradle dir)
- fmap IdeResultOk action
+ fmap Right action
runActionWithContext publishDiagnostics df (Just uri) def action = do
mcradle <- getCradle uri
loadCradle publishDiagnostics df mcradle def action
@@ -130,7 +129,7 @@ loadCradle :: forall a m . (MonadIde m, HasGhcModuleCache m, GHC.GhcMonad m
loadCradle _ _ ReuseCradle _def action = do
-- Since we expect this message to show up often, only show in debug mode
debugm "Reusing cradle"
- IdeResultOk <$> action
+ Right <$> action
loadCradle _ _iniDynFlags (LoadCradle (CachedCradle crd env co)) _def action = do
-- Reloading a cradle happens on component switch
@@ -139,7 +138,7 @@ loadCradle _ _iniDynFlags (LoadCradle (CachedCradle crd env co)) _def action = d
maybe (return ()) cacheCradle =<< (currentCradle <$> getModuleCache)
GHC.setSession env
setCurrentCradle crd co
- IdeResultOk <$> action
+ Right <$> action
loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
-- If this message shows up a lot in the logs, it is an indicator for a bug
@@ -154,15 +153,10 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
Right cradle -> do
logm $ "Found cradle: " ++ show cradle
withProgress ("Initializing " <> cradleDisplay cradle) NotCancellable (initialiseCradle cradle)
- Left yamlErr ->
- return $ IdeResultFail $ IdeError
- { ideCode = OtherError
- , ideMessage = Text.pack $ "Couldn't parse hie.yaml: " <> yamlErr
- , ideInfo = Aeson.Null
- }
+ Left yamlErr -> ideErrorFrom OtherError "Couldn't parse hie.yaml" yamlErr
where
- -- | Initialise the given cradle. This might fail and return an error via `IdeResultFail`.
+ -- | Initialise the given cradle. This might fail and return an error via `ideError`.
-- Reports its progress to the client.
initialiseCradle :: Bios.Cradle -> (Progress -> IO ()) -> m (IdeResult a)
initialiseCradle cradle f = do
@@ -171,7 +165,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
Bios.CradleNone ->
-- Note: The action is not run if we are in the none cradle, we
-- just pretend the file doesn't exist.
- return $ IdeResultOk def
+ return $ Right def
Bios.CradleFail (Bios.CradleError code msg) -> do
warningm $ "Fail on cradle initialisation: (" ++ show code ++ ")" ++ show msg
@@ -189,11 +183,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
liftIO $ publishDiagnostics normalizedUri Nothing
(Map.singleton source (SL.singleton diag))
- return $ IdeResultFail $ IdeError
- { ideCode = OtherError
- , ideMessage = Text.unwords (take 2 msgTxt)
- , ideInfo = Aeson.Null
- }
+ ideError OtherError $ Text.unwords $ take 2 msgTxt
Bios.CradleSuccess (init_session, copts) -> do
-- Note that init_session contains a Hook to 'f'.
-- So, it can still provide Progress Reports.
@@ -215,11 +205,7 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
case init_res of
Left err -> do
logm $ "Ghc error on cradle initialisation: " ++ show err
- return $ IdeResultFail $ IdeError
- { ideCode = OtherError
- , ideMessage = Text.pack $ show err
- , ideInfo = Aeson.Null
- }
+ ideError OtherError $ Text.pack $ show err
-- Note: Don't setCurrentCradle because we want to try to reload
-- it on a save whilst there are errors. Subsequent loads won't
-- be that slow, even though the cradle isn't cached because the
@@ -227,12 +213,12 @@ loadCradle publishDiagnostics iniDynFlags (NewCradle fp) def action = do
Right Bios.Succeeded -> do
setCurrentCradle cradle copts
logm "Cradle set succesfully"
- IdeResultOk <$> action
+ Right <$> action
Right Bios.Failed -> do
setCurrentCradle cradle copts
logm "Cradle did not load succesfully"
- IdeResultOk <$> action
+ Right <$> action
-- TODO remove after hie-bios update
initializeFlagsWithCradleWithMessage ::
diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs
index 6e6a273d0..942d93d61 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs
@@ -52,7 +52,7 @@ module Haskell.Ide.Engine.PluginApi
, LSP.Uri
, HIE.ifCachedModule
, HIE.CachedInfo(..)
- , HIE.IdeResult(..)
+ , HIE.IdeResult
-- * used for tests in HaRe
, BiosLogLevel
diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs
index aa21d692c..0813ab6be 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs
@@ -40,7 +40,6 @@ module Haskell.Ide.Engine.PluginUtils
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Except
-import Data.Aeson
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import qualified Data.HashMap.Strict as H
@@ -124,15 +123,14 @@ srcSpan2Loc revMapp spn = runExceptT $ do
-- | Helper function that extracts a filepath from a Uri if the Uri
-- is well formed (i.e. begins with a file:// )
--- fails with an IdeResultFail otherwise
+-- fails with an ideError otherwise
pluginGetFile
:: Monad m
=> T.Text -> Uri -> (FilePath -> m (IdeResult a)) -> m (IdeResult a)
pluginGetFile name uri f =
case uriToFilePath uri of
Just file -> f file
- Nothing -> return $ IdeResultFail (IdeError PluginError
- (name <> "Couldn't resolve uri" <> getUri uri) Null)
+ Nothing -> ideError PluginError $ name <> "Couldn't resolve uri" <> getUri uri
-- ---------------------------------------------------------------------
-- courtesy of http://stackoverflow.com/questions/19891061/mapeithers-function-in-haskell
diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs
index 78b33c42e..f3e22203a 100644
--- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs
+++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs
@@ -73,8 +73,10 @@ module Haskell.Ide.Engine.PluginsIdeMonads
, iterT
, LiftsToGhc(..)
-- * IdeResult
- , IdeResult(..)
- , IdeResultT(..)
+ , IdeResult
+ , IdeResultT
+ , ideError
+ , ideErrorFrom
, Defer(..)
, IdeError(..)
, IdeErrorCode(..)
@@ -94,11 +96,14 @@ module Haskell.Ide.Engine.PluginsIdeMonads
, PublishDiagnosticsParams(..)
, List(..)
, FormattingOptions(..)
+ , ExceptT(..)
+ , runExceptT
)
where
import Control.Monad.IO.Class
import Control.Monad.Reader
+import Control.Monad.Trans.Except
import Control.Monad.Trans.Free
import Control.Monad.Trans.Control
import Control.Monad.Base
@@ -116,6 +121,8 @@ import Data.Maybe
import qualified Data.Set as S
import Data.String
import qualified Data.Text as T
+import Data.Text.Lens as T
+import qualified Control.Lens as L
import Data.Typeable ( TypeRep )
#if __GLASGOW_HASKELL__ < 808
@@ -251,7 +258,7 @@ data FormattingType = FormatText
-- The Uri is mainly used to discover formatting configurations in the file's path.
--
-- Fails if the formatter can not parse the source.
--- Failing means here that a IdeResultFail is returned.
+-- Failing means here that an ideError is returned.
-- This can be used to display errors to the user, unless the error is an Internal one.
-- The record 'IdeError' and 'IdeErrorCode' can be used to determine the type of error.
--
@@ -317,14 +324,13 @@ runPluginCommand :: PluginId -> CommandId -> Value
runPluginCommand p@(PluginId p') com@(CommandId com') arg = do
IdePlugins m <- getPlugins
case Map.lookup p m of
- Nothing -> return $
- IdeResultFail $ IdeError UnknownPlugin ("Plugin " <> p' <> " doesn't exist") Null
+ Nothing -> ideError UnknownPlugin $ "Plugin " <> p' <> " doesn't exist"
Just PluginDescriptor { pluginCommands = xs } -> case List.find ((com ==) . commandId) xs of
- Nothing -> return $ IdeResultFail $
- IdeError UnknownCommand ("Command " <> com' <> " isn't defined for plugin " <> p' <> ". Legal commands are: " <> T.pack(show $ map commandId xs)) Null
+ Nothing -> ideError UnknownCommand
+ $ "Command " <> com' <> " isn't defined for plugin " <> p' <> ". Legal commands are: " <> T.pack (show $ map commandId xs)
Just (PluginCommand _ _ f) -> case fromJSON arg of
- Error err -> return $ IdeResultFail $
- IdeError ParameterError ("error while parsing args for " <> com' <> " in plugin " <> p' <> ": " <> T.pack err) Null
+ Error err -> ideError ParameterError
+ $ "error while parsing args for " <> com' <> " in plugin " <> p' <> ": " <> T.pack err
Success a -> do
res <- f a
return $ fmap toDynJSON res
@@ -508,45 +514,14 @@ instance HasGhcModuleCache IdeM where
-- | The result of a plugin action, containing the result and an error if
-- it failed. IdeGhcM usually skips IdeResponse and jumps straight to this.
-data IdeResult a = IdeResultOk a
- | IdeResultFail IdeError
- deriving (Eq, Show, Generic, ToJSON, FromJSON)
+type IdeResult = Either IdeError
+type IdeResultT = ExceptT IdeError
-instance Functor IdeResult where
- fmap f (IdeResultOk x) = IdeResultOk (f x)
- fmap _ (IdeResultFail err) = IdeResultFail err
+ideError :: (IsText t, Monad m) => IdeErrorCode -> t -> m (IdeResult a)
+ideError code msg = return $ Left $ IdeError code (T.pack $ msg L.^. L.re T.packed) Null
-instance Applicative IdeResult where
- pure = return
- (IdeResultFail err) <*> _ = IdeResultFail err
- _ <*> (IdeResultFail err) = IdeResultFail err
- (IdeResultOk f) <*> (IdeResultOk x) = IdeResultOk (f x)
-
-instance Monad IdeResult where
- return = IdeResultOk
- IdeResultOk x >>= f = f x
- IdeResultFail err >>= _ = IdeResultFail err
-
-newtype IdeResultT m a = IdeResultT { runIdeResultT :: m (IdeResult a) }
-
-instance Monad m => Functor (IdeResultT m) where
- fmap = liftM
-
-instance Monad m => Applicative (IdeResultT m) where
- pure = return
- (<*>) = ap
-
-instance (Monad m) => Monad (IdeResultT m) where
- return = IdeResultT . return . IdeResultOk
-
- m >>= f = IdeResultT $ do
- v <- runIdeResultT m
- case v of
- IdeResultOk x -> runIdeResultT (f x)
- IdeResultFail err -> return $ IdeResultFail err
-
-instance MonadTrans IdeResultT where
- lift m = IdeResultT (fmap IdeResultOk m)
+ideErrorFrom :: (IsText t, Monad m) => IdeErrorCode -> String -> t -> m (IdeResult a)
+ideErrorFrom code source msg = return $ Left $ IdeError code (T.pack $ source ++ " :" ++ msg L.^. L.re T.packed) Null
-- | Error codes. Add as required
data IdeErrorCode
diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal
index c20e9c5e5..82b48adda 100644
--- a/hie-plugin-api/hie-plugin-api.cabal
+++ b/hie-plugin-api/hie-plugin-api.cabal
@@ -56,6 +56,7 @@ library
, haskell-lsp == 0.19.*
, hslogger
, unliftio
+ , lens
, monad-control
, mtl
, process
diff --git a/src/Haskell/Ide/Engine/CodeActions.hs b/src/Haskell/Ide/Engine/CodeActions.hs
index 3939ae5d3..29f098ea8 100644
--- a/src/Haskell/Ide/Engine/CodeActions.hs
+++ b/src/Haskell/Ide/Engine/CodeActions.hs
@@ -38,7 +38,7 @@ handleCodeActionReq tn req = do
let getProvider p = pluginCodeActionProvider p <*> return (pluginId p)
getProviders = do
IdePlugins m <- getPlugins
- return $ IdeResultOk $ mapMaybe getProvider $ toList m
+ return $ Right $ mapMaybe getProvider $ toList m
providersCb providers =
let reqs = map (\f -> lift (f docId range context)) providers
diff --git a/src/Haskell/Ide/Engine/Completions.hs b/src/Haskell/Ide/Engine/Completions.hs
index 9e3ad2cf5..0db440877 100644
--- a/src/Haskell/Ide/Engine/Completions.hs
+++ b/src/Haskell/Ide/Engine/Completions.hs
@@ -329,7 +329,7 @@ getCompletions uri prefixInfo withSnippets =
let enteredQual = if T.null prefixModule then "" else prefixModule <> "."
fullPrefix = enteredQual <> prefixText
- ifCachedModuleAndData file (IdeResultOk [])
+ ifCachedModuleAndData file (Right [])
$ \tm CachedInfo { newPosToOld } CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules } ->
let
-- default to value context if no explicit context
@@ -418,7 +418,7 @@ getCompletions uri prefixInfo withSnippets =
= filtModNameCompls ++ map (toggleSnippets caps withSnippets
. mkCompl . stripAutoGenerated) filtCompls
in
- return $ IdeResultOk result
+ return $ Right result
where
validPragmas :: [(T.Text, T.Text)]
validPragmas =
diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs
index 7f0ec83ff..0f6b43b2e 100644
--- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs
+++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs
@@ -82,15 +82,13 @@ applyOneCmd (AOP uri pos title) = pluginGetFile "applyOne: " uri $ \fp -> do
revMapp <- reverseFileMap
let defaultResult = do
debugm "applyOne: no access to the persisted file."
- return $ IdeResultOk mempty
+ return $ Right mempty
withMappedFile fp defaultResult $ \file' -> do
res <- liftToGhc $ applyHint file' (Just oneHint) revMapp
logm $ "applyOneCmd:file=" ++ show fp
logm $ "applyOneCmd:res=" ++ show res
- case res of
- Left err -> return $ IdeResultFail
- (IdeError PluginError (T.pack $ "applyOne: " ++ show err) Null)
- Right fs -> return (IdeResultOk fs)
+ return $ res & _Left %~ \err ->
+ IdeError PluginError (T.pack $ "applyOne: " ++ show err) Null
-- ---------------------------------------------------------------------
@@ -99,15 +97,13 @@ applyAllCmd :: Uri -> IdeGhcM (IdeResult WorkspaceEdit)
applyAllCmd uri = pluginGetFile "applyAll: " uri $ \fp -> do
let defaultResult = do
debugm "applyAll: no access to the persisted file."
- return $ IdeResultOk mempty
+ return $ Right mempty
revMapp <- reverseFileMap
withMappedFile fp defaultResult $ \file' -> do
res <- liftToGhc $ applyHint file' Nothing revMapp
logm $ "applyAllCmd:res=" ++ show res
- case res of
- Left err -> return $ IdeResultFail (IdeError PluginError
- (T.pack $ "applyAll: " ++ show err) Null)
- Right fs -> return (IdeResultOk fs)
+ return $ res & _Left %~ \err ->
+ IdeError PluginError (T.pack $ "applyAll: " ++ show err) Null
-- ---------------------------------------------------------------------
@@ -118,26 +114,18 @@ lint uri = pluginGetFile "lint: " uri $ \fp -> do
defaultResult = do
debugm "lint: no access to the persisted file."
return
- $ IdeResultOk (PublishDiagnosticsParams (filePathToUri fp) $ List [])
+ $ Right $ PublishDiagnosticsParams (filePathToUri fp) $ List []
withMappedFile fp defaultResult $ \file' -> do
eitherErrorResult <- liftIO
(try $ runExceptT $ runLint file' [] :: IO
(Either IOException (Either [Diagnostic] [Idea]))
)
case eitherErrorResult of
- Left err -> return $ IdeResultFail
- (IdeError PluginError (T.pack $ "lint: " ++ show err) Null)
- Right res -> case res of
- Left diags ->
- return
- (IdeResultOk
- (PublishDiagnosticsParams (filePathToUri fp) $ List diags)
- )
- Right fs ->
- return
- $ IdeResultOk
- $ PublishDiagnosticsParams (filePathToUri fp)
- $ List (map hintToDiagnostic $ stripIgnores fs)
+ Left err -> ideErrorFrom PluginError "lint" $ show err
+ Right res -> return $ Right $
+ PublishDiagnosticsParams (filePathToUri fp) $ List $ case res of
+ Left diags -> diags
+ Right fs -> map hintToDiagnostic $ stripIgnores fs
runLint :: FilePath -> [String] -> ExceptT [Diagnostic] IO [Idea]
runLint fp args = do
@@ -311,7 +299,7 @@ showParseError (Hlint.ParseError location message content) =
-- ---------------------------------------------------------------------
codeActionProvider :: CodeActionProvider
-codeActionProvider plId docId _ context = IdeResultOk <$> hlintActions
+codeActionProvider plId docId _ context = Right <$> hlintActions
where
hlintActions :: IdeM [LSP.CodeAction]
diff --git a/src/Haskell/Ide/Engine/Plugin/Brittany.hs b/src/Haskell/Ide/Engine/Plugin/Brittany.hs
index eb46310e9..ebc16169e 100644
--- a/src/Haskell/Ide/Engine/Plugin/Brittany.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Brittany.hs
@@ -5,11 +5,9 @@ module Haskell.Ide.Engine.Plugin.Brittany where
import Control.Lens
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
-import Data.Aeson
import Data.Coerce
import Data.Semigroup
import Data.Text (Text)
-import qualified Data.Text as T
import Haskell.Ide.Engine.MonadTypes
import Haskell.Ide.Engine.PluginUtils
import Language.Haskell.Brittany
@@ -50,14 +48,10 @@ provider text uri formatType opts = pluginGetFile "brittanyCmd: " uri $ \fp -> d
res <- formatText confFile opts selectedContents
case res of
- Left err -> return $ IdeResultFail
- (IdeError PluginError
- (T.pack $ "brittanyCmd: " ++ unlines (map showErr err))
- Null
- )
+ Left err -> ideErrorFrom PluginError "brittanyCmd: " $ unlines $ map showErr err
Right newText -> do
let textEdit = J.TextEdit range newText
- return $ IdeResultOk [textEdit]
+ return $ Right [textEdit]
-- | Primitive to format text with the given option.
-- May not throw exceptions but return a Left value.
diff --git a/src/Haskell/Ide/Engine/Plugin/Example2.hs b/src/Haskell/Ide/Engine/Plugin/Example2.hs
index 7c49e9371..225904e19 100644
--- a/src/Haskell/Ide/Engine/Plugin/Example2.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Example2.hs
@@ -41,12 +41,12 @@ example2Descriptor plId = PluginDescriptor
-- ---------------------------------------------------------------------
sayHelloCmd :: () -> IdeGhcM (IdeResult T.Text)
-sayHelloCmd () = return (IdeResultOk sayHello)
+sayHelloCmd () = return (Right sayHello)
sayHelloToCmd :: T.Text -> IdeGhcM (IdeResult T.Text)
sayHelloToCmd n = do
r <- liftIO $ sayHelloTo n
- return $ IdeResultOk r
+ return $ Right r
-- ---------------------------------------------------------------------
@@ -69,7 +69,7 @@ diagnosticProvider trigger uri = do
, _message = "Example plugin diagnostic, triggered by" <> T.pack (show trigger)
, _relatedInformation = Nothing
}
- return $ IdeResultOk $ Map.fromList [(uri,S.singleton diag)]
+ return $ Right $ Map.fromList [(uri,S.singleton diag)]
-- ---------------------------------------------------------------------
@@ -80,7 +80,7 @@ data TodoParams = TodoParams
deriving (Show, Eq, Generics.Generic, ToJSON, FromJSON)
todoCmd :: TodoParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
-todoCmd (TodoParams uri r) = return $ IdeResultOk $ makeTodo uri r
+todoCmd (TodoParams uri r) = return $ Right $ makeTodo uri r
makeTodo :: J.Uri -> J.Range -> J.WorkspaceEdit
makeTodo uri (J.Range (J.Position startLine _) _) = res
@@ -100,7 +100,7 @@ makeTodo uri (J.Range (J.Position startLine _) _) = res
codeActionProvider :: CodeActionProvider
codeActionProvider plId docId r _context = do
cmd <- mkLspCommand plId "todo" title (Just cmdParams)
- return $ IdeResultOk [codeAction cmd]
+ return $ Right [codeAction cmd]
where
codeAction :: J.Command -> J.CodeAction
codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd)
diff --git a/src/Haskell/Ide/Engine/Plugin/Floskell.hs b/src/Haskell/Ide/Engine/Plugin/Floskell.hs
index 25f72895d..4817b0b10 100644
--- a/src/Haskell/Ide/Engine/Plugin/Floskell.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Floskell.hs
@@ -7,9 +7,7 @@ module Haskell.Ide.Engine.Plugin.Floskell
where
import Control.Monad.IO.Class (liftIO)
-import Data.Aeson (Value (Null))
import qualified Data.ByteString.Lazy as BS
-import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Floskell
import Haskell.Ide.Engine.MonadTypes
@@ -38,10 +36,9 @@ provider contents uri typ _opts =
let (range, selectedContents) = case typ of
FormatText -> (fullRange contents, contents)
FormatRange r -> (r, extractRange r contents)
- result = reformat config (Just file) (BS.fromStrict (T.encodeUtf8 selectedContents))
- case result of
- Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "floskellCmd: " ++ err) Null)
- Right new -> return $ IdeResultOk [TextEdit range (T.decodeUtf8 (BS.toStrict new))]
+ case reformat config (Just file) $ BS.fromStrict $ T.encodeUtf8 selectedContents of
+ Left err -> ideErrorFrom PluginError "floskellCmd" err
+ Right new -> return $ Right [TextEdit range $ T.decodeUtf8 $ BS.toStrict new]
-- | Find Floskell Config, user and system wide or provides a default style.
-- Every directory of the filepath will be searched to find a user configuration.
diff --git a/src/Haskell/Ide/Engine/Plugin/Generic.hs b/src/Haskell/Ide/Engine/Plugin/Generic.hs
index 6f734ce60..cbb29f72f 100644
--- a/src/Haskell/Ide/Engine/Plugin/Generic.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Generic.hs
@@ -74,9 +74,9 @@ typeCmd (TP _bool uri pos) = liftToGhc $ newTypeCmd pos uri
newTypeCmd :: Position -> Uri -> IdeM (IdeResult [(Range, T.Text)])
newTypeCmd newPos uri =
pluginGetFile "newTypeCmd: " uri $ \fp ->
- ifCachedModule fp (IdeResultOk []) $ \tm info -> do
+ ifCachedModule fp (Right []) $ \tm info -> do
debugm $ "newTypeCmd: " <> show (newPos, uri)
- return $ IdeResultOk $ pureTypeCmd newPos tm info
+ return $ Right $ pureTypeCmd newPos tm info
pureTypeCmd :: Position -> GHC.TypecheckedModule -> CachedInfo -> [(Range,T.Text)]
pureTypeCmd newPos tm info =
@@ -162,12 +162,12 @@ codeActionProvider' supportsDocChanges _ docId _ context =
topLevelSignatureActions = map (uncurry mkMissingSignatureAction) missingSignatures
unusedTerms = mapMaybe getUnusedTerms diags
unusedTermActions = map (uncurry mkUnusedTermAction) unusedTerms
- in return $ IdeResultOk $ concat [ renameActions
- , redundantActions
- , typedHoleActions
- , topLevelSignatureActions
- , unusedTermActions
- ]
+ in return $ Right $ concat [ renameActions
+ , redundantActions
+ , typedHoleActions
+ , topLevelSignatureActions
+ , unusedTermActions
+ ]
where
@@ -383,17 +383,16 @@ extractUnusedTerm msg = Hie.extractTerm <$> stripMessageStart msg
-- ---------------------------------------------------------------------
hoverProvider :: HoverProvider
-hoverProvider doc pos = runIdeResultT $ do
- info' <- IdeResultT $ newTypeCmd pos doc
- names' <- IdeResultT $ pluginGetFile "ghc-mod:hoverProvider" doc $ \fp ->
- ifCachedModule fp (IdeResultOk []) $ \(_ :: GHC.ParsedModule) info ->
- return $ IdeResultOk $ Hie.getSymbolsAtPoint pos info
+hoverProvider doc pos = runExceptT $ do
+ info' <- ExceptT $ newTypeCmd pos doc
+ names' <- ExceptT $ pluginGetFile "ghc-mod:hoverProvider" doc $ \fp ->
+ ifCachedModule fp (Right []) $ \(_ :: GHC.ParsedModule) info ->
+ return $ Right $ Hie.getSymbolsAtPoint pos info
let
f = (==) `on` (Hie.showName . snd)
f' = compare `on` (Hie.showName . snd)
names = mapMaybe pickName $ groupBy f $ sortBy f' names'
pickName [] = Nothing
- pickName [x] = Just x
pickName xs@(x:_) = case find (isJust . nameModule_maybe . snd) xs of
Nothing -> Just x
Just a -> Just a
@@ -423,7 +422,7 @@ data Decl = Decl LSP.SymbolKind (Located RdrName) [Decl] SrcSpan
symbolProvider :: Uri -> IdeDeferM (IdeResult [LSP.DocumentSymbol])
symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $
- \file -> withCachedModule file (IdeResultOk []) $ \pm _ -> do
+ \file -> withCachedModule file (Right []) $ \pm _ -> do
let hsMod = unLoc $ pm_parsed_source pm
imports = hsmodImports hsMod
imps = concatMap goImport imports
@@ -594,4 +593,4 @@ symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $
_ -> return childrenSymbols
symInfs <- concat <$> mapM declsToSymbolInf (imps ++ decls)
- return $ IdeResultOk symInfs
+ return $ Right symInfs
diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
index beb2ea6dc..7050ba61a 100644
--- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
+++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
@@ -5,6 +5,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
module Haskell.Ide.Engine.Plugin.GhcMod
(
ghcmodDescriptor
@@ -74,7 +75,7 @@ checkCmd = HIE.setTypecheckedModule
splitCaseCmd :: Hie.HarePoint -> IdeGhcM (IdeResult WorkspaceEdit)
splitCaseCmd (Hie.HP _uri _pos)
- = return (IdeResultFail (IdeError PluginError "splitCaseCmd not implemented" Null))
+ = ideError @String PluginError "splitCaseCmd not implemented"
-- ---------------------------------------------------------------------
diff --git a/src/Haskell/Ide/Engine/Plugin/Haddock.hs b/src/Haskell/Ide/Engine/Plugin/Haddock.hs
index 1c1daef57..f6c9088db 100644
--- a/src/Haskell/Ide/Engine/Plugin/Haddock.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Haddock.hs
@@ -223,7 +223,7 @@ renderMarkDown =
hoverProvider :: HoverProvider
hoverProvider doc pos = pluginGetFile "haddock:hoverProvider" doc $ \fp ->
- ifCachedModule fp (IdeResultOk mempty) $ \tm info -> runIdeResultT $ do
+ ifCachedModule fp (Right mempty) $ \tm info -> runExceptT $ do
let df = getDynFlags tm
names = mapMaybe pickName $ groupBy f $ sortBy f' $ getSymbolsAtPoint pos info
docs <- forM names $ \(_,name) -> do
diff --git a/src/Haskell/Ide/Engine/Plugin/HfaAlign.hs b/src/Haskell/Ide/Engine/Plugin/HfaAlign.hs
index bcb793ff9..4b270b109 100644
--- a/src/Haskell/Ide/Engine/Plugin/HfaAlign.hs
+++ b/src/Haskell/Ide/Engine/Plugin/HfaAlign.hs
@@ -51,7 +51,7 @@ alignCmd :: AlignParams -> IdeGhcM (IdeResult J.WorkspaceEdit)
alignCmd (AlignParams uri rg) = do
mtext <- getRangeFromVFS uri rg
case mtext of
- Nothing -> return $ IdeResultOk $ J.WorkspaceEdit Nothing Nothing
+ Nothing -> return $ Right $ J.WorkspaceEdit Nothing Nothing
Just txt -> do
let
adjusted = adjustText txt
@@ -59,14 +59,14 @@ alignCmd (AlignParams uri rg) = do
res = J.WorkspaceEdit
(Just $ H.singleton uri textEdits)
Nothing
- return $ IdeResultOk res
+ return $ Right res
-- ---------------------------------------------------------------------
codeActionProvider :: CodeActionProvider
codeActionProvider plId docId (Range (Position sl _) (Position el _)) _context = do
cmd <- mkLspCommand plId "align" title (Just cmdParams)
- return $ IdeResultOk [codeAction cmd]
+ return $ Right [codeAction cmd]
where
codeAction :: J.Command -> J.CodeAction
codeAction cmd = J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd)
diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs
index 1a2253c26..bf7bbc09e 100644
--- a/src/Haskell/Ide/Engine/Plugin/HsImport.hs
+++ b/src/Haskell/Ide/Engine/Plugin/HsImport.hs
@@ -132,7 +132,7 @@ importModule (ImportParams uri impStyle modName) =
fileMap <- reverseFileMap
let defaultResult = do
debugm "hsimport: no access to the persisted file."
- return $ IdeResultOk mempty
+ return $ Right mempty
withMappedFile origInput defaultResult $ \input -> do
tmpDir <- liftIO getTemporaryDirectory
(output, outputH) <- liftIO $ openTempFile tmpDir "hsimportOutput"
@@ -147,8 +147,7 @@ importModule (ImportParams uri impStyle modName) =
case maybeErr of
Just err -> do
liftIO $ removeFile output
- let msg = T.pack $ show err
- return $ IdeResultFail (IdeError PluginError msg Null)
+ ideError PluginError $ show err
Nothing -> do
-- Since no error happened, calculate the differences of
-- the original file and after the import has been done.
@@ -168,7 +167,7 @@ importModule (ImportParams uri impStyle modName) =
-- Client may have no formatter selected
-- but still the option to format on import.
Nothing ->
- return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
+ return $ Right $ J.WorkspaceEdit mChanges mDocChanges
Just (_, provider) -> do
let
@@ -198,9 +197,9 @@ importModule (ImportParams uri impStyle modName) =
formatEdit origEdit@(J.TextEdit r t) = do
-- TODO: are these default FormattingOptions ok?
formatEdits <-
- liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) >>= \case
- IdeResultOk xs -> return xs
- _ -> return [origEdit]
+ liftToGhc $ provider t uri FormatText (FormattingOptions 2 True) <&> \case
+ Right xs -> xs
+ _ -> [origEdit]
-- let edits = foldl' J.editTextEdit origEdit formatEdits -- TODO: this seems broken.
return (J.TextEdit r (renormalise t . J._newText $ head formatEdits))
@@ -213,9 +212,8 @@ importModule (ImportParams uri impStyle modName) =
return $ J.TextDocumentEdit vids newEdits
mapM cmd change
- return
- $ IdeResultOk (J.WorkspaceEdit newChanges newDocChanges)
- else return $ IdeResultOk (J.WorkspaceEdit mChanges mDocChanges)
+ return $ Right $ J.WorkspaceEdit newChanges newDocChanges
+ else return $ Right $ J.WorkspaceEdit mChanges mDocChanges
-- | Convert the import style arguments into HsImport arguments.
-- Takes an input and an output file as well as a module name.
@@ -282,8 +280,8 @@ codeActionProvider plId docId _ context = do
-- If we didn't find any exact matches, relax the search terms.
-- Only looks for the function names, not the exact siganture.
relaxedActions <- importActionsForTerms ExactName terms
- return $ IdeResultOk relaxedActions
- else return $ IdeResultOk actions
+ return $ Right relaxedActions
+ else return $ Right actions
where
-- | Creates CodeActions from the diagnostics to add imports.
diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs
index 1553c4d12..7bbc2e427 100644
--- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs
@@ -93,7 +93,7 @@ instance ExtensionClass LiquidData where
diagnosticProvider :: DiagnosticProviderFuncAsync
diagnosticProvider DiagnosticOnSave uri cb = pluginGetFile "Liquid.diagnosticProvider:" uri $ \file ->
- withCachedModuleAndData file (IdeResultOk ()) $ \_tm _info () -> do
+ withCachedModuleAndData file (Right ()) $ \_tm _info () -> do
-- New save, kill any prior instance that was running
LiquidData mtid <- get
mapM_ (liftIO . cancel) mtid
@@ -105,8 +105,8 @@ diagnosticProvider DiagnosticOnSave uri cb = pluginGetFile "Liquid.diagnosticPro
put (LiquidData (Just tid))
- return $ IdeResultOk ()
-diagnosticProvider _ _ _ = return (IdeResultOk ())
+ return $ Right ()
+diagnosticProvider _ _ _ = return $ Right ()
-- ---------------------------------------------------------------------
@@ -240,11 +240,11 @@ liquidFileFor uri ext =
hoverProvider :: HoverProvider
hoverProvider uri pos =
pluginGetFile "Liquid.hoverProvider: " uri $ \file ->
- ifCachedModuleAndData file (IdeResultOk []) $
+ ifCachedModuleAndData file (Right []) $
\_ info () -> do
merrs <- liftIO $ readVimAnnot uri
case merrs of
- Nothing -> return (IdeResultOk [])
+ Nothing -> return $ Right []
Just lerrs -> do
let perrs = map (\le@(LE s e _) -> (lpToPos s,lpToPos e,le)) lerrs
ls = getThingsAtPos info pos perrs
@@ -252,7 +252,7 @@ hoverProvider uri pos =
let msgs = T.splitOn "\\n" msg
msgm = J.markedUpContent "haskell" (T.unlines msgs)
return $ J.Hover (J.HoverContents msgm) (Just r)
- return (IdeResultOk hs)
+ return $ Right hs
-- ---------------------------------------------------------------------
diff --git a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs
index b23109ed9..2bc41529b 100644
--- a/src/Haskell/Ide/Engine/Plugin/Ormolu.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Ormolu.hs
@@ -10,7 +10,6 @@ import Haskell.Ide.Engine.MonadTypes
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class ( liftIO , MonadIO(..) )
-import Data.Aeson ( Value ( Null ) )
import Data.List
import Data.Maybe
import qualified Data.Text as T
@@ -37,21 +36,20 @@ provider :: FormattingProvider
provider _contents _uri _typ _opts =
#if __GLASGOW_HASKELL__ >= 806
case _typ of
- FormatRange _ -> return $ IdeResultFail (IdeError PluginError (T.pack "Selection formatting for Ormolu is not currently supported.") Null)
+ FormatRange _ -> ideError @String PluginError "Selection formatting for Ormolu is not currently supported."
FormatText -> pluginGetFile _contents _uri $ \file -> do
opts <- lookupComponentOptions file
let opts' = map DynOption $ filter exop $ join $ maybeToList $ componentOptions <$> opts
conf = Config opts' False False True False
- result <- liftIO $ try @OrmoluException (ormolu conf file (T.unpack _contents))
-
+ result <- liftIO $ try @OrmoluException $ ormolu conf file $ T.unpack _contents
case result of
- Left err -> return $ IdeResultFail (IdeError PluginError (T.pack $ "ormoluCmd: " ++ show err) Null)
- Right new -> return $ IdeResultOk [TextEdit (fullRange _contents) new]
+ Left err -> ideErrorFrom PluginError "ormoluCmd" $ show err
+ Right new -> return $ Right [TextEdit (fullRange _contents) new]
where
exop s =
"-X" `isPrefixOf` s
|| "-fplugin=" `isPrefixOf` s
|| "-pgmF=" `isPrefixOf` s
#else
- return $ IdeResultOk [] -- NOP formatter
+ return $ Right [] -- NOP formatter
#endif
diff --git a/src/Haskell/Ide/Engine/Plugin/Package.hs b/src/Haskell/Ide/Engine/Plugin/Package.hs
index 481cb7224..6e8e32547 100644
--- a/src/Haskell/Ide/Engine/Plugin/Package.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Package.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
-- | Commands and code actions for adding package dependencies into .cabal and
-- package.yaml files
@@ -109,7 +110,7 @@ addCmd (AddParams rootDir modulePath pkg) = do
absFp <- liftIO $ canonicalizePath relFp
let relModulePath = makeRelative (takeDirectory absFp) modulePath
liftToGhc $ editHpackPackage absFp relModulePath pkg
- NoPackage -> return $ IdeResultFail (IdeError PluginError "No package.yaml or .cabal found" Null)
+ NoPackage -> ideError @String PluginError "No package.yaml or .cabal found"
data PackageType = CabalPackage FilePath -- ^ Location of Cabal File. May be relative.
| HpackPackage FilePath -- ^ Location of `package.yaml`. May be relative.
@@ -190,8 +191,8 @@ editHpackPackage fp modulePath pkgName = do
then J.WorkspaceEdit Nothing (Just (J.List [textDocEdit]))
else J.WorkspaceEdit (Just (HM.singleton docUri (J.List [textEdit]))) Nothing
- return $ IdeResultOk wsEdit
- Nothing -> return $ IdeResultFail (IdeError PluginError "Couldn't parse package.yaml" Null)
+ return $ Right wsEdit
+ Nothing -> ideError @String PluginError "Couldn't parse package.yaml"
where
@@ -269,7 +270,7 @@ editCabalPackage file modulePath pkgName fileMap = do
let newContents = T.pack $ PP.showGenericPackageDescription newPackage
- IdeResultOk <$> makeAdditiveDiffResult file newContents fileMap
+ Right <$> makeAdditiveDiffResult file newContents fileMap
where
@@ -320,7 +321,7 @@ codeActionProvider plId docId _ context = do
res <- mapM (bimapM return Hoogle.searchPackages) pkgs
actions <- catMaybes <$> mapM (uncurry (mkAddPackageAction mRootDir)) (concatPkgs res)
- return (IdeResultOk actions)
+ return $ Right actions
where
concatPkgs = concatMap (\(d, ts) -> map (d,) ts)
diff --git a/src/Haskell/Ide/Engine/Plugin/Pragmas.hs b/src/Haskell/Ide/Engine/Plugin/Pragmas.hs
index ba1e973b5..12e2160f6 100644
--- a/src/Haskell/Ide/Engine/Plugin/Pragmas.hs
+++ b/src/Haskell/Ide/Engine/Plugin/Pragmas.hs
@@ -59,7 +59,7 @@ addPragmaCmd (AddPragmaParams uri pragmaName) = do
res = J.WorkspaceEdit
(Just $ H.singleton uri textEdits)
Nothing
- return $ IdeResultOk res
+ return $ Right res
-- ---------------------------------------------------------------------
@@ -68,7 +68,7 @@ addPragmaCmd (AddPragmaParams uri pragmaName) = do
codeActionProvider :: CodeActionProvider
codeActionProvider plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
cmds <- mapM mkCommand pragmas
- return $ IdeResultOk cmds
+ return $ Right cmds
where
-- Filter diagnostics that are from ghcmod
ghcDiags = filter (\d -> d ^. J.source == Just "bios") diags
diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs
index c155d15e8..c256f5367 100644
--- a/src/Haskell/Ide/Engine/Scheduler.hs
+++ b/src/Haskell/Ide/Engine/Scheduler.hs
@@ -303,8 +303,8 @@ ideDispatcher env errorHandler callbackHandler pin =
unlessCancelled env lid errorHandler $ liftIO $ do
completedReq env lid
case result of
- IdeResultOk x -> callbackHandler callback x
- IdeResultFail (IdeError _ msg _) ->
+ Right x -> callbackHandler callback x
+ Left (IdeError _ msg _) ->
errorHandler (Just lid) J.InternalError msg
liftIO $ traceEventIO $ "STOP " ++ show tn ++ "ide:" ++ d
@@ -356,8 +356,8 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler publishDiagnosti
runWithCallback = do
result <- runner (pure def) action
liftIO $ case join result of
- IdeResultOk x -> callbackHandler callback x
- IdeResultFail err@(IdeError _ msg _) -> do
+ Right x -> callbackHandler callback x
+ Left err@(IdeError _ msg _) -> do
logm $ "ghcDispatcher:Got error for a request: " ++ show err ++ " with mid: " ++ show mid
errorHandler mid J.InternalError msg
diff --git a/src/Haskell/Ide/Engine/Server.hs b/src/Haskell/Ide/Engine/Server.hs
index 5191d45c7..c0181e08c 100644
--- a/src/Haskell/Ide/Engine/Server.hs
+++ b/src/Haskell/Ide/Engine/Server.hs
@@ -285,7 +285,7 @@ getPrefixAtPos uri pos = do
-- TODO: generalise this and move it to GhcMod.ModuleLoader
updatePositionMap :: Uri -> [J.TextDocumentContentChangeEvent] -> IdeGhcM (IdeResult ())
updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file ->
- ifCachedInfo file (IdeResultOk ()) $ \info -> do
+ ifCachedInfo file (Right ()) $ \info -> do
let n2oOld = newPosToOld info
o2nOld = oldPosToNew info
(n2o,o2n) = foldl' go (n2oOld, o2nOld) changes
@@ -294,7 +294,7 @@ updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file
go _ _ = (const Nothing, const Nothing)
let info' = info {newPosToOld = n2o, oldPosToNew = o2n}
cacheInfoNoClear file info'
- return $ IdeResultOk ()
+ return $ Right ()
where
f (+/-) (J.Range (Position sl sc) (Position el ec)) txt p@(Position l c)
@@ -471,7 +471,7 @@ reactor inp diagIn = do
fmServerLogMessageNotification J.MtLog $ "Using hie version: " <> T.pack hieVersion
renv <- ask
- let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb
+ let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ Right <$> Hoogle.initializeHoogleDb
callback Nothing = flip runReaderT renv $
reactorSend $ NotShowMessage $
fmServerShowMessageNotification J.MtWarning "No hoogle db found. Check the README for instructions to generate one"
@@ -544,7 +544,7 @@ reactor inp diagIn = do
makeRequest $ GReq tn "delete-cache" (Just uri) Nothing Nothing (const $ return ()) () $ do
forM_ (uriToFilePath uri)
deleteCachedModule
- return $ IdeResultOk ()
+ return $ Right ()
-- -------------------------------
@@ -695,7 +695,7 @@ reactor inp diagIn = do
callback res = do
let rspMsg = Core.makeResponseMessage req $ res
reactorSend $ RspCompletionItemResolve rspMsg
- hreq = IReq tn "completion" (req ^. J.id) callback $ runIdeResultT $ do
+ hreq = IReq tn "completion" (req ^. J.id) callback $ runExceptT $
lift $ lift $ Completions.resolveCompletion snippets origCompl
makeRequest hreq
@@ -862,7 +862,7 @@ getFormattingProvider = do
let msg = providerName <> " is not a recognised plugin for formatting. Check your config"
reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning msg
reactorSend $ NotLogMessage $ fmServerLogMessageNotification J.MtWarning msg
- return (\_ _ _ _ -> return (IdeResultOk [])) -- nop formatter
+ return $ \_ _ _ _ -> return $ Right [] -- nop formatter
Just (_, provider) -> return provider
-- ---------------------------------------------------------------------
diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs
index 2238922e6..9ad947dab 100644
--- a/src/Haskell/Ide/Engine/Support/HieExtras.hs
+++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs
@@ -5,6 +5,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
module Haskell.Ide.Engine.Support.HieExtras
( getDynFlags
, getTypeForName
@@ -184,14 +185,14 @@ symbolFromTypecheckedModule lm pos =
getReferencesInDoc :: Uri -> Position -> IdeDeferM (IdeResult [J.DocumentHighlight])
getReferencesInDoc uri pos =
pluginGetFile "getReferencesInDoc: " uri $ \file ->
- withCachedModuleAndData file (IdeResultOk []) $
+ withCachedModuleAndData file (Right []) $
\tcMod info NMD{inverseNameMap} -> do
let lm = locMap info
pm = tm_parsed_module tcMod
cfile = ml_hs_file $ ms_location $ pm_mod_summary pm
mpos = newPosToOld info pos
case mpos of
- Nothing -> return $ IdeResultOk []
+ Nothing -> return $ Right []
Just pos' -> return $ fmap concat $
forM (getArtifactsAtPos pos' lm) $ \(_,name) -> do
let usages = fromMaybe [] $ Map.lookup name inverseNameMap
@@ -265,7 +266,7 @@ findTypeDef :: Uri -> Position -> IdeDeferM (IdeResult [Location])
findTypeDef uri pos = pluginGetFile "findTypeDef: " uri $ \file ->
withCachedInfo
file
- (IdeResultOk []) -- Default result
+ (Right []) -- Default result
(\info -> do
let rfm = revMap info
tmap = typeMap info
@@ -297,7 +298,7 @@ findTypeDef uri pos = pluginGetFile "findTypeDef: " uri $ \file ->
Just s -> Right s
runExceptT (getTypeSrcSpanFromPosition oldPos) >>= \case
- Left () -> return $ IdeResultOk []
+ Left () -> return $ Right []
Right realSpan ->
lift $ srcSpanToFileLocation "hare:findTypeDef" rfm realSpan
)
@@ -305,7 +306,7 @@ findTypeDef uri pos = pluginGetFile "findTypeDef: " uri $ \file ->
-- | Return the definition
findDef :: Uri -> Position -> IdeDeferM (IdeResult [Location])
findDef uri pos = pluginGetFile "findDef: " uri $ \file ->
- withCachedInfo file (IdeResultOk []) (\info -> do
+ withCachedInfo file (Right []) (\info -> do
let rfm = revMap info
lm = locMap info
mm = moduleMap info
@@ -314,10 +315,10 @@ findDef uri pos = pluginGetFile "findDef: " uri $ \file ->
case (\x -> Just $ getArtifactsAtPos x mm) =<< oldPos of
Just ((_,mn):_) -> gotoModule rfm mn
_ -> case symbolFromTypecheckedModule lm =<< oldPos of
- Nothing -> return $ IdeResultOk []
+ Nothing -> return $ Right []
Just (_, n) ->
case nameSrcSpan n of
- UnhelpfulSpan _ -> return $ IdeResultOk []
+ UnhelpfulSpan _ -> return $ Right []
realSpan -> lift $ srcSpanToFileLocation "hare:findDef" rfm realSpan
)
@@ -332,17 +333,14 @@ srcSpanToFileLocation invoker rfm srcSpan = do
case res of
Right l@(J.Location luri range) ->
case uriToFilePath luri of
- Nothing -> return $ IdeResultOk [l]
- Just fp -> ifCachedModule fp (IdeResultOk [l]) $ \(_ :: ParsedModule) info' ->
+ Nothing -> return $ Right [l]
+ Just fp -> ifCachedModule fp (Right [l]) $ \(_ :: ParsedModule) info' ->
case oldRangeToNew info' range of
- Just r -> return $ IdeResultOk [J.Location luri r]
- Nothing -> return $ IdeResultOk [l]
+ Just r -> return $ Right [J.Location luri r]
+ Nothing -> return $ Right [l]
Left x -> do
debugm (T.unpack invoker <> ": name srcspan not found/valid")
- pure (IdeResultFail
- (IdeError PluginError
- (invoker <> ": \"" <> x <> "\"")
- Null))
+ ideError PluginError $ invoker <> ": \"" <> x <> "\""
-- | Goto given module.
gotoModule :: (FilePath -> FilePath) -> ModuleName -> IdeDeferM (IdeResult [Location])
@@ -365,10 +363,9 @@ gotoModule rfm mn = do
let r = Range (Position 0 0) (Position 0 0)
loc = Location (filePathToUri fp) r
- return (IdeResultOk [loc])
- _ -> return (IdeResultOk [])
- Nothing -> return $ IdeResultFail
- (IdeError PluginError "Couldn't get hscEnv when finding import" Null)
+ return $ Right [loc]
+ _ -> return $ Right []
+ Nothing -> ideError @String PluginError "Couldn't get hscEnv when finding import"
-- ---------------------------------------------------------------------
data HarePoint =
@@ -390,11 +387,9 @@ instance ToJSON HarePoint where
runGhcModCommand :: IdeGhcM a
-> IdeGhcM (IdeResult a)
runGhcModCommand cmd =
- (IdeResultOk <$> cmd) `gcatch`
+ (Right <$> cmd) `gcatch`
\(e :: GM.GhcModError) ->
- return $
- IdeResultFail $
- IdeError PluginError (T.pack $ "hie-ghc-mod: " ++ show e) Null
+ ideErrorFrom PluginError "hie-ghc-mod" $ show e
-}
-- ---------------------------------------------------------------------
@@ -407,7 +402,7 @@ splitCaseCmd' :: Uri -> Position -> IdeGhcM (IdeResult WorkspaceEdit)
splitCaseCmd' uri newPos =
pluginGetFile "splitCaseCmd: " uri $ \path -> do
origText <- GM.withMappedFile path $ liftIO . T.readFile
- ifCachedModule path (IdeResultOk mempty) $ \tm info -> runGhcModCommand $
+ ifCachedModule path (Right mempty) $ \tm info -> runGhcModCommand $
case newPosToOld info newPos of
Just oldPos -> do
let (line, column) = unPos oldPos
diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs
index 106cce7cc..fbd464d5a 100644
--- a/test/dispatcher/Main.hs
+++ b/test/dispatcher/Main.hs
@@ -143,11 +143,11 @@ funcSpec = describe "functional dispatch" $ do
let
hoverReqHandler :: TypecheckedModule -> CachedInfo -> IdeDeferM (IdeResult Cached)
- hoverReqHandler _ _ = return (IdeResultOk Cached)
+ hoverReqHandler _ _ = return $ Right Cached
-- Model a hover request
hoverReq tn idVal doc = dispatchIdeRequest tn ("IReq " ++ show idVal) scheduler logChan idVal $ do
pluginGetFile "hoverReq" doc $ \fp ->
- ifCachedModule fp (IdeResultOk NotCached) hoverReqHandler
+ ifCachedModule fp (Right NotCached) hoverReqHandler
unpackRes (r,Right md) = (r, fromDynJSON md)
unpackRes r = error $ "unpackRes:" ++ show r
diff --git a/test/plugin-dispatcher/Main.hs b/test/plugin-dispatcher/Main.hs
index db356c5cc..9e7ba80ce 100644
--- a/test/plugin-dispatcher/Main.hs
+++ b/test/plugin-dispatcher/Main.hs
@@ -36,11 +36,11 @@ newPluginSpec = do
let defCallback = atomically . writeTChan outChan
delayedCallback = \r -> threadDelay 10000 >> defCallback r
- let req0 = GReq 0 "0" Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ IdeResultOk $ T.pack "text0"
- req1 = GReq 1 "1" Nothing Nothing (Just $ IdInt 1) defCallback "none" $ return $ IdeResultOk $ T.pack "text1"
- req2 = GReq 2 "2" Nothing Nothing (Just $ IdInt 2) delayedCallback "none" $ return $ IdeResultOk $ T.pack "text2"
- req3 = GReq 3 "3" Nothing (Just (filePathToUri "test", 2)) Nothing defCallback "none" $ return $ IdeResultOk $ T.pack "text3"
- req4 = GReq 4 "4" Nothing Nothing (Just $ IdInt 3) defCallback "none" $ return $ IdeResultOk $ T.pack "text4"
+ let req0 = GReq 0 "0" Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ Right $ T.pack "text0"
+ req1 = GReq 1 "1" Nothing Nothing (Just $ IdInt 1) defCallback "none" $ return $ Right $ T.pack "text1"
+ req2 = GReq 2 "2" Nothing Nothing (Just $ IdInt 2) delayedCallback "none" $ return $ Right $ T.pack "text2"
+ req3 = GReq 3 "3" Nothing (Just (filePathToUri "test", 2)) Nothing defCallback "none" $ return $ Right $ T.pack "text3"
+ req4 = GReq 4 "4" Nothing Nothing (Just $ IdInt 3) defCallback "none" $ return $ Right $ T.pack "text4"
let makeReq = sendRequest scheduler
diff --git a/test/unit/ApplyRefactPluginSpec.hs b/test/unit/ApplyRefactPluginSpec.hs
index 408594be7..1fdd1b6ed 100644
--- a/test/unit/ApplyRefactPluginSpec.hs
+++ b/test/unit/ApplyRefactPluginSpec.hs
@@ -45,7 +45,7 @@ applyRefactSpec = do
act = applyOneCmd arg
arg = AOP furi (toPos (2,8)) "Redundant bracket"
textEdits = List [TextEdit (Range (Position 1 0) (Position 1 25)) "main = putStrLn \"hello\""]
- res = IdeResultOk $ WorkspaceEdit
+ res = Right $ WorkspaceEdit
(Just $ H.singleton applyRefactPath textEdits)
Nothing
testCommand testPlugins applyRefactFp act "applyrefact" "applyOne" arg res
@@ -58,7 +58,7 @@ applyRefactSpec = do
arg = applyRefactPath
textEdits = List [ TextEdit (Range (Position 1 0) (Position 1 25)) "main = putStrLn \"hello\""
, TextEdit (Range (Position 3 0) (Position 3 15)) "foo x = x + 1" ]
- res = IdeResultOk $ WorkspaceEdit
+ res = Right $ WorkspaceEdit
(Just $ H.singleton applyRefactPath textEdits)
Nothing
testCommand testPlugins applyRefactFp act "applyrefact" "applyAll" arg res
@@ -68,7 +68,7 @@ applyRefactSpec = do
it "returns hints as diagnostics" $ do
let act = lint applyRefactPath
- res = IdeResultOk
+ res = Right
PublishDiagnosticsParams
{ _uri = applyRefactPath
, _diagnostics = List $
@@ -94,7 +94,7 @@ applyRefactSpec = do
let filePath = filePathToUri filePathNoUri
let act = lint filePath
- res = IdeResultOk
+ res = Right
PublishDiagnosticsParams
{ _uri = filePath
, _diagnostics = List
@@ -114,20 +114,19 @@ applyRefactSpec = do
let filePath = filePathToUri fp
let req = lint filePath
r <- runIGM testPlugins fp req
- r `shouldBe`
- (IdeResultOk
- (PublishDiagnosticsParams
- { _uri = filePath
- , _diagnostics = List
- [ Diagnostic (Range (Position 3 11) (Position 3 20))
- (Just DsInfo)
- (Just (StringValue "Redundant bracket"))
- (Just "hlint")
- "Redundant bracket\nFound:\n (\"hello\")\nWhy not:\n \"hello\"\n"
- Nothing
- ]
- }
- ))
+ r `shouldBe` Right
+ PublishDiagnosticsParams
+ { _uri = filePath
+ , _diagnostics = List
+ [ Diagnostic (Range (Position 3 11) (Position 3 20))
+ (Just DsInfo)
+ (Just (StringValue "Redundant bracket"))
+ (Just "hlint")
+ "Redundant bracket\nFound:\n (\"hello\")\nWhy not:\n \"hello\"\n"
+ Nothing
+ ]
+ }
+
-- ---------------------------------
@@ -137,14 +136,12 @@ applyRefactSpec = do
let req = lint filePath
r <- withCurrentDirectory "./test/testdata" $ runIGM testPlugins fp req
- r `shouldBe`
- (IdeResultOk
- (PublishDiagnosticsParams
- -- { _uri = filePathToUri "./HlintPragma.hs"
- { _uri = filePath
- , _diagnostics = List []
- }
- ))
+ r `shouldBe` Right
+ PublishDiagnosticsParams
+ -- { _uri = filePathToUri "./HlintPragma.hs"
+ { _uri = filePath
+ , _diagnostics = List []
+ }
-- ---------------------------------
@@ -152,7 +149,7 @@ applyRefactSpec = do
fp <- makeAbsolute "./test/testdata/ApplyRefactError.hs"
let filePath = filePathToUri fp
let req = applyAllCmd filePath
- isExpectedError (IdeResultFail (IdeError PluginError err _)) =
+ isExpectedError (Left (IdeError PluginError err _)) =
"Illegal symbol " `T.isInfixOf` err
isExpectedError _ = False
r <- withCurrentDirectory "./test/testdata" $ runIGM testPlugins fp req
diff --git a/test/unit/ContextSpec.hs b/test/unit/ContextSpec.hs
index 722325098..a3860221d 100644
--- a/test/unit/ContextSpec.hs
+++ b/test/unit/ContextSpec.hs
@@ -22,10 +22,10 @@ spec = describe "Context of different cursor positions" $ do
$ do
fp <- makeAbsolute "./ExampleContext.hs"
let arg = filePathToUri fp
- let res = IdeResultOk (Nothing :: Maybe Context)
+ let res = Right (Nothing :: Maybe Context)
actual <- runSingle (IdePlugins mempty) fp $ do
_ <- setTypecheckedModule arg
- return $ IdeResultOk Nothing
+ return $ Right Nothing
actual `shouldBe` res
@@ -33,7 +33,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just (ModuleContext "ExampleContext"))
+ let res = Right $ Just $ ModuleContext "ExampleContext"
actual <- getContextAt fp (toPos (1, 10))
@@ -44,42 +44,42 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ExportContext)
+ let res = Right $ Just ExportContext
actual <- getContextAt fp (toPos (1, 24))
actual `shouldBe` res
it "value context" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ValueContext)
+ let res = Right $ Just ValueContext
actual <- getContextAt fp (toPos (7, 6))
actual `shouldBe` res
it "value addition context" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ValueContext)
+ let res = Right $ Just ValueContext
actual <- getContextAt fp (toPos (7, 12))
actual `shouldBe` res
it "import context" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just (ImportContext "Data.List"))
+ let res = Right $ Just $ ImportContext "Data.List"
actual <- getContextAt fp (toPos (3, 8))
actual `shouldBe` res
it "import list context" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just (ImportListContext "Data.List"))
+ let res = Right $ Just $ ImportListContext "Data.List"
actual <- getContextAt fp (toPos (3, 20))
actual `shouldBe` res
it "import hiding context" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just (ImportHidingContext "Control.Monad"))
+ let res = Right $ Just $ ImportHidingContext "Control.Monad"
actual <- getContextAt fp (toPos (4, 32))
actual `shouldBe` res
@@ -88,7 +88,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just TypeContext)
+ let res = Right $ Just TypeContext
actual <- getContextAt fp (toPos (6, 1))
actual `shouldBe` res
@@ -97,7 +97,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just TypeContext)
+ let res = Right $ Just TypeContext
actual <- getContextAt fp (toPos (6, 8))
actual `shouldBe` res
@@ -106,7 +106,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ValueContext)
+ let res = Right $ Just ValueContext
actual <- getContextAt fp (toPos (7, 1))
actual `shouldBe` res
@@ -119,7 +119,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ValueContext)
+ let res = Right $ Just ValueContext
actual <- getContextAt fp (toPos (9, 10))
actual `shouldBe` res
@@ -127,7 +127,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just ValueContext)
+ let res = Right $ Just ValueContext
actual <- getContextAt fp (toPos (10, 10))
actual `shouldBe` res
@@ -137,7 +137,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (12, 8))
actual `shouldBe` res
@@ -146,7 +146,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just TypeContext)
+ let res = Right $ Just TypeContext
actual <- getContextAt fp (toPos (12, 18))
actual `shouldBe` res
@@ -155,7 +155,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (15, 8))
actual `shouldBe` res
@@ -165,7 +165,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (16, 7))
actual `shouldBe` res
@@ -173,7 +173,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (18, 7))
actual `shouldBe` res
@@ -183,7 +183,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (19, 6))
actual `shouldBe` res
@@ -194,7 +194,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (13, 9))
actual `shouldBe` res
@@ -206,7 +206,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (13, 14))
actual `shouldBe` res
@@ -220,7 +220,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just TypeContext)
+ let res = Right (Just TypeContext)
actual <- getContextAt fp (toPos (13, 15))
actual `shouldBe` res
@@ -228,7 +228,7 @@ spec = describe "Context of different cursor positions" $ do
$ withCurrentDirectory "./test/testdata/context"
$ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk (Just TypeContext)
+ let res = Right (Just TypeContext)
actual <- getContextAt fp (toPos (13, 18))
actual `shouldBe` res
@@ -236,7 +236,7 @@ spec = describe "Context of different cursor positions" $ do
-- There is no context
it "nothing" $ withCurrentDirectory "./test/testdata/context" $ do
fp <- makeAbsolute "./ExampleContext.hs"
- let res = IdeResultOk Nothing
+ let res = Right Nothing
actual <- getContextAt fp (toPos (2, 1))
actual `shouldBe` res
@@ -246,5 +246,5 @@ getContextAt fp pos = do
runSingle (IdePlugins mempty) fp $ do
_ <- setTypecheckedModule arg
pluginGetFile "getContext: " arg $ \fp_ ->
- ifCachedModuleAndData fp_ (IdeResultOk Nothing) $ \tm _ () ->
- return $ IdeResultOk $ getContext pos (tm_parsed_module tm)
+ ifCachedModuleAndData fp_ (Right Nothing) $ \tm _ () ->
+ return $ Right $ getContext pos (tm_parsed_module tm)
diff --git a/test/unit/ExtensibleStateSpec.hs b/test/unit/ExtensibleStateSpec.hs
index 3e8489c54..11dfdb92a 100644
--- a/test/unit/ExtensibleStateSpec.hs
+++ b/test/unit/ExtensibleStateSpec.hs
@@ -28,8 +28,8 @@ extensibleStateSpec =
r1 <- makeRequest "test" "cmd1" ()
r2 <- makeRequest "test" "cmd2" ()
return (r1,r2)
- fmap fromDynJSON (fst r) `shouldBe` IdeResultOk (Just "result:put foo" :: Maybe T.Text)
- fmap fromDynJSON (snd r) `shouldBe` IdeResultOk (Just "result:got:\"foo\"" :: Maybe T.Text)
+ fmap fromDynJSON (fst r) `shouldBe` Right (Just "result:put foo" :: Maybe T.Text)
+ fmap fromDynJSON (snd r) `shouldBe` Right (Just "result:got:\"foo\"" :: Maybe T.Text)
-- ---------------------------------------------------------------------
@@ -56,13 +56,13 @@ testDescriptor plId = PluginDescriptor
cmd1 :: () -> IdeGhcM (IdeResult T.Text)
cmd1 () = do
- put (MS1 "foo")
- return (IdeResultOk (T.pack "result:put foo"))
+ put $ MS1 "foo"
+ return $ Right $ T.pack "result:put foo"
cmd2 :: () -> IdeGhcM (IdeResult T.Text)
cmd2 () = do
- (MS1 v) <- get
- return (IdeResultOk (T.pack $ "result:got:" ++ show v))
+ MS1 v <- get
+ return $ Right $ T.pack $ "result:got:" ++ show v
newtype MyState1 = MS1 T.Text deriving Typeable
diff --git a/test/unit/GenericPluginSpec.hs b/test/unit/GenericPluginSpec.hs
index 2fb58a7d2..c73f6d7b0 100644
--- a/test/unit/GenericPluginSpec.hs
+++ b/test/unit/GenericPluginSpec.hs
@@ -39,13 +39,13 @@ ghcmodSpec =
fp <- makeAbsolute "./FileWithWarning.hs"
let act = setTypecheckedModule arg
arg = filePathToUri fp
- IdeResultOk (_,env) <- runSingle testPlugins fp act
+ Right (_,env) <- runSingle testPlugins fp act
case env of
[] -> return ()
[s] -> T.unpack s `shouldStartWith` "Loaded package environment from"
ss -> fail $ "got:" ++ show ss
let
- res = IdeResultOk $
+ res = Right
(Diagnostics (Map.singleton (toNormalizedUri arg) (S.singleton diag)), env)
diag = Diagnostic (Range (toPos (4,7))
(toPos (4,8)))
@@ -65,9 +65,9 @@ ghcmodSpec =
-- act = lintCmd' uri
-- arg = uri
-- #if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)))
--- res = IdeResultOk (T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULPerhaps:\NUL return (3 + x)\n")
+-- res = Right $ T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULPerhaps:\NUL return (3 + x)\n"
-- #else
--- res = IdeResultOk (T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULWhy not:\NUL return (3 + x)\n")
+-- res = Right $ T.pack fp <> ":6:9: Warning: Redundant do\NULFound:\NUL do return (3 + x)\NULWhy not:\NUL return (3 + x)\n"
-- #endif
-- testCommand testPlugins act "bios" "lint" arg res
@@ -78,7 +78,7 @@ ghcmodSpec =
-- let uri = filePathToUri fp
-- act = infoCmd' uri "main"
-- arg = IP uri "main"
- -- res = IdeResultOk "main :: IO () \t-- Defined at HaReRename.hs:2:1\n"
+ -- res = Right "main :: IO () \t-- Defined at HaReRename.hs:2:1\n"
-- -- ghc-mod tries to load the test file in the context of the hie project if we do not cd first.
-- testCommand testPlugins act "bios" "info" arg res
@@ -91,7 +91,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (5,9)) uri
arg = TP False uri (toPos (5,9))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (5,9)) (toPos (5,10)), "Int")
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
]
@@ -105,7 +105,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (2,11)) uri
arg = TP False uri (toPos (2,11))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (2, 8)) (toPos (2,16)), "String -> IO ()")
, (Range (toPos (2, 1)) (toPos (2,24)), "IO ()")
]
@@ -118,7 +118,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (1,1)) uri
arg = TP False uri (toPos (1,1))
- res = IdeResultOk []
+ res = Right []
testCommand testPlugins fp act "generic" "type" arg res
it "runs the type command, simple" $ withCurrentDirectory "./test/testdata" $ do
@@ -128,7 +128,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (6,16)) uri
arg = TP False uri (toPos (6,16))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (6, 16)) (toPos (6,17)), "Int")
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
]
@@ -141,7 +141,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (6,6)) uri
arg = TP False uri (toPos (6, 6))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (6, 6)) (toPos (6, 12)), "Maybe Int")
, (Range (toPos (6, 5)) (toPos (6, 13)), "Maybe Int")
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
@@ -155,7 +155,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (6,11)) uri
arg = TP False uri (toPos (6, 11))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (6, 11)) (toPos (6, 12)), "Int")
, (Range (toPos (6, 6)) (toPos (6, 12)), "Maybe Int")
, (Range (toPos (6, 5)) (toPos (6, 13)), "Maybe Int")
@@ -170,7 +170,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (7,5)) uri
arg = TP False uri (toPos (7,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (7, 5)) (toPos (7, 12)), "Maybe Int")
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
]
@@ -183,7 +183,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (7,15)) uri
arg = TP False uri (toPos (7,15))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (7, 15)) (toPos (7, 16)), "Int")
, (Range (toPos (6, 1)) (toPos (7, 16)), "Maybe Int -> Int")
]
@@ -196,7 +196,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (10,5)) uri
arg = TP False uri (toPos (10,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (10, 5)) (toPos (10, 6)), "Maybe Int")
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
]
@@ -209,7 +209,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (10,14)) uri
arg = TP False uri (toPos (10,14))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (10, 14)) (toPos (10, 15)), "Maybe Int")
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
@@ -223,7 +223,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (11,5)) uri
arg = TP False uri (toPos (11,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (11, 5)) (toPos (11, 11)), "Maybe Int")
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
@@ -237,7 +237,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (11,10)) uri
arg = TP False uri (toPos (11,10))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (11, 10)) (toPos (11, 11)), "Int")
, (Range (toPos (11, 5)) (toPos (11, 11)), "Maybe Int")
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
@@ -252,7 +252,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (11,17)) uri
arg = TP False uri (toPos (11,17))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (11, 17)) (toPos (11, 18)), "Int -> Int -> Int")
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
@@ -266,7 +266,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (12,5)) uri
arg = TP False uri (toPos (12,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (12, 5)) (toPos (12, 12)), "Maybe Int")
, (Range (toPos (10, 9)) (toPos (12, 17)), "Maybe Int -> Int")
, (Range (toPos (10, 1)) (toPos (12, 17)), "Maybe Int -> Int")
@@ -280,7 +280,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (16,5)) uri
arg = TP False uri (toPos (16,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (16, 5)) (toPos (16, 6)), "Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
@@ -293,7 +293,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (16,10)) uri
arg = TP False uri (toPos (16,10))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (16, 10)) (toPos (16, 11)), "Maybe Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
@@ -306,7 +306,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (17,13)) uri
arg = TP False uri (toPos (17,13))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (17, 13)) (toPos (17, 19)), "Int -> Maybe Int")
, (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
@@ -320,7 +320,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (17,21)) uri
arg = TP False uri (toPos (17,21))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (17, 21)) (toPos (17, 22)), "Int")
, (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
@@ -334,7 +334,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (17,9)) uri
arg = TP False uri (toPos (17,9))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (17, 9)) (toPos (17, 28)), "Maybe Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
@@ -347,7 +347,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (18,10)) uri
arg = TP False uri (toPos (18,10))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (18, 10)) (toPos (18, 11)), "Maybe Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
@@ -360,7 +360,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (18,5)) uri
arg = TP False uri (toPos (18,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (18, 5)) (toPos (18, 6)), "Int")
, (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
@@ -373,7 +373,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (15,5)) uri
arg = TP False uri (toPos (15,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (15, 1)) (toPos (19, 19)), "Maybe Int -> Maybe Int")
]
testCommand testPlugins fp act "generic" "type" arg res
@@ -385,7 +385,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (22,10)) uri
arg = TP False uri (toPos (22,10))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (22, 10)) (toPos (22, 11)), "a -> a")
, (Range (toPos (22, 1)) (toPos (22, 19)), "(a -> a) -> a -> a")
]
@@ -398,7 +398,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (25,26)) uri
arg = TP False uri (toPos (25,26))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (25, 26)) (toPos (25, 27)), "(b -> c) -> (a -> b) -> a -> c")
, (Range (toPos (25, 20)) (toPos (25, 29)), "a -> c")
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
@@ -412,7 +412,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (25,20)) uri
arg = TP False uri (toPos (25,20))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (25, 20)) (toPos (25, 29)), "a -> c")
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
]
@@ -425,7 +425,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (25,33)) uri
arg = TP False uri (toPos (25,33))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (25, 33)) (toPos (25, 34)), "a -> c")
, (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
]
@@ -438,7 +438,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (25,5)) uri
arg = TP False uri (toPos (25,5))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (25, 1)) (toPos (25, 34)), "(b -> c) -> (a -> b) -> a -> c")
]
testCommand testPlugins fp act "generic" "type" arg res
@@ -450,7 +450,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (28,25)) uri
arg = TP False uri (toPos (28,25))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (28, 25)) (toPos (28, 28)), "(a -> b) -> IO a -> IO b")
, (Range (toPos (28, 1)) (toPos (28, 35)), "(a -> b) -> IO a -> IO b")
]
@@ -463,7 +463,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (31,7)) uri
arg = TP False uri (toPos (31,7))
- res = IdeResultOk
+ res = Right
[ -- (Range (toPos (31, 7)) (toPos (31, 12)), "Int -> Test")
]
testCommand testPlugins fp act "generic" "type" arg res
@@ -475,7 +475,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (33,15)) uri
arg = TP False uri (toPos (33,15))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (33, 15)) (toPos (33, 19)), "(Int -> Test -> ShowS) -> (Test -> String) -> ([Test] -> ShowS) -> Show Test")
, (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS")
, (Range (toPos (33, 15)) (toPos (33, 19)), "Test -> String")
@@ -490,7 +490,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (33,21)) uri
arg = TP False uri (toPos (33,21))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (33, 21)) (toPos (33, 23)), "(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test")
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
, (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool")
@@ -510,7 +510,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (5,9)) uri
let arg = TP False uri (toPos (5,9))
- let res = IdeResultOk
+ let res = Right
[(Range (toPos (5,9)) (toPos (5,10)), "Int")
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
]
@@ -525,7 +525,7 @@ ghcmodSpec =
-- _ <- setTypecheckedModule uri
-- splitCaseCmd' uri (toPos (5,5))
-- arg = HP uri (toPos (5,5))
--- res = IdeResultOk $ WorkspaceEdit
+-- res = Right $ WorkspaceEdit
-- (Just $ H.singleton uri
-- $ List [TextEdit (Range (Position 4 0) (Position 4 10))
-- "foo Nothing = ()\nfoo (Just x) = ()"])
@@ -544,7 +544,7 @@ ghcmodSpec =
-- _ <- setTypecheckedModule uri
-- splitCaseCmd' uri (toPos (5,5))
-- arg = HP uri (toPos (5,5))
--- res = IdeResultOk $ WorkspaceEdit
+-- res = Right $ WorkspaceEdit
-- (Just $ H.singleton uri
-- $ List [TextEdit (Range (Position 4 0) (Position 4 10))
-- "foo Nothing = ()\nfoo (Just x) = ()"])
diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs
index d2f84e805..2f95c021b 100644
--- a/test/unit/GhcModPluginSpec.hs
+++ b/test/unit/GhcModPluginSpec.hs
@@ -39,13 +39,13 @@ ghcmodSpec =
fp <- makeAbsolute "./FileWithWarning.hs"
let act = setTypecheckedModule arg
arg = filePathToUri fp
- IdeResultOk (_,env) <- runSingle testPlugins fp act
+ Right (_,env) <- runSingle testPlugins fp act
case env of
[] -> return ()
[s] -> T.unpack s `shouldStartWith` "Loaded package environment from"
ss -> fail $ "got:" ++ show ss
let
- res = IdeResultOk $
+ res = Right
(Diagnostics (Map.singleton (toNormalizedUri arg) (S.singleton diag)), env)
diag = Diagnostic (Range (toPos (4,7))
(toPos (4,8)))
@@ -67,7 +67,7 @@ ghcmodSpec =
_ <- setTypecheckedModule uri
liftToGhc $ newTypeCmd (toPos (5,9)) uri
arg = TP False uri (toPos (5,9))
- res = IdeResultOk
+ res = Right
[ (Range (toPos (5,9)) (toPos (5,10)), "Int")
, (Range (toPos (5,1)) (toPos (5,14)), "Int -> Int")
]
@@ -85,7 +85,7 @@ ghcmodSpec =
-- -- splitCaseCmd' uri (toPos (5,5))
-- splitCaseCmd uri (toPos (5,5))
-- arg = HP uri (toPos (5,5))
- -- res = IdeResultOk $ WorkspaceEdit
+ -- res = Right $ WorkspaceEdit
-- (Just $ H.singleton uri
-- $ List [TextEdit (Range (Position 4 0) (Position 4 10))
-- "foo Nothing = ()\nfoo (Just x) = ()"])
diff --git a/test/unit/HsImportSpec.hs b/test/unit/HsImportSpec.hs
index 5bc2107a7..eca63b9a7 100644
--- a/test/unit/HsImportSpec.hs
+++ b/test/unit/HsImportSpec.hs
@@ -193,7 +193,7 @@ setFormatter formatterName cfg = cfg { Config.formattingProvider = formatterName
expectHsImportResult :: T.Text -> FilePath -> Uri -> [TextEdit] -> IdeGhcM (IdeResult WorkspaceEdit) -> IO ()
expectHsImportResult formatterName fp uri expectedChanges act = do
- IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
+ Right (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
case Map.lookup uri changes of
Just (List val) -> val `shouldBe` expectedChanges
Nothing -> fail "No Change found"
\ No newline at end of file
diff --git a/test/unit/PackagePluginSpec.hs b/test/unit/PackagePluginSpec.hs
index 68a5c4151..c4c2a524f 100644
--- a/test/unit/PackagePluginSpec.hs
+++ b/test/unit/PackagePluginSpec.hs
@@ -105,7 +105,7 @@ packageSpec = do
, " text -any"
]
]
- res = IdeResultOk
+ res = Right
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
testCommand testPlugins fp act "package" "add" args res
@@ -160,7 +160,7 @@ packageSpec = do
, " text -any"
]
]
- res = IdeResultOk
+ res = Right
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
testCommand testPlugins fp act "package" "add" args res
@@ -173,7 +173,7 @@ packageSpec = do
uri = filePathToUri $ fp </> "package.yaml"
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
act = addCmd args
- res = IdeResultOk
+ res = Right
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
textEdits = List
[ TextEdit (Range (Position 0 0) (Position 32 0)) $ T.concat
@@ -211,7 +211,7 @@ packageSpec = do
uri = filePathToUri $ fp </> "package.yaml"
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
act = addCmd args
- res = IdeResultOk
+ res = Right
$ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing
textEdits =
List
@@ -243,10 +243,8 @@ packageSpec = do
fp = cwd </> testdata </> "invalid"
args = AddParams fp (fp </> "app" </> "Asdf.hs") "zlib"
act = addCmd args
- res =
- IdeResultFail
- (IdeError PluginError
- "No package.yaml or .cabal found"
- Json.Null
- )
+ res = Left $ IdeError
+ PluginError
+ "No package.yaml or .cabal found"
+ Json.Null
testCommand testPlugins fp act "package" "add" args res