Put IdeResult in terms of Either, add ideError

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)
 
 -- ---------------------------------------------------------------------

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
 ```
 

docs/Dispatch.md

@@ -29,10 +29,10 @@
             |         IdeResult                                            |
             |          +    +                                              |
             |          v    |                                              |
-            | IdeResultFail |                                              |
-            |               v                                              |
-            |          IdeResultOk                                         |
-            |               +                                              |
+            |      IdeError |                                              |
+            |               |                                              |
+            |               |                                              |
+            |               |                                              |
             |               v                                              |
             |          RequestCallback                                     |
             v               +                                              v

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)
 
 {-
 

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,24 +205,20 @@ 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
             -- `.hi` files will be saved.
           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 ::

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

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

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

hie-plugin-api/hie-plugin-api.cabal

@@ -56,6 +56,7 @@ library
                      , haskell-lsp == 0.19.*
                      , hslogger
                      , unliftio
+                     , lens
                      , monad-control
                      , mtl
                      , process

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

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 =