Rework MonadIde class

Author: lukel97

hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs

@@ -269,14 +269,14 @@ clientSupportsDocumentChanges = do
 
 -- ---------------------------------------------------------------------
 
-readVFS :: MonadIde m => Uri -> m (Maybe T.Text)
+readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text)
 readVFS uri = do
   mvf <- getVirtualFile uri
   case mvf of
     Just (VirtualFile _ txt) -> return $ Just (Yi.toText txt)
     Nothing -> return Nothing
 
-getRangeFromVFS :: MonadIde m => Uri -> Range -> m (Maybe T.Text)
+getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text)
 getRangeFromVFS uri rg = do
   mvf <- getVirtualFile uri
   case mvf of

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

@@ -49,8 +49,17 @@ module Haskell.Ide.Engine.PluginsIdeMonads
   , IdeM
   , runIdeM
   , IdeDeferM
-  , MonadIde(..)
+  -- ** MonadIde and functions
+  , MonadIde
+  , getRootPath
+  , getVirtualFile
+  , getConfig
+  , getClientCapabilities
+  , getPlugins
+  , withProgress
+  , withIndefiniteProgress
   , Core.Progress(..)
+  -- ** Lifting
   , iterT
   , LiftsToGhc(..)
   -- * IdeResult
@@ -345,94 +354,69 @@ data IdeEnv = IdeEnv
   }
 
 -- | The class of monads that support common IDE functions, namely IdeM/IdeGhcM/IdeDeferM
-class MonadIO m => MonadIde m where
-  getRootPath :: m (Maybe FilePath)
-  getVirtualFile :: Uri -> m (Maybe VirtualFile)
-  getConfig :: m Config
-  getClientCapabilities :: m ClientCapabilities
-  getPlugins :: m IdePlugins
-  -- 'withProgress' @title f@ wraps a progress reporting session for long running tasks.
-  -- f is passed a reporting function that can be used to give updates on the progress
-  -- of the task.
-  withProgress :: T.Text -> ((Core.Progress -> m ()) -> m a) -> m a
-  -- 'withIndefiniteProgress' @title f@ is the same as the 'withProgress' but for tasks
-  -- which do not continuously report their progress. 
-  withIndefiniteProgress :: T.Text -> m a -> m a
-
-instance MonadIO m => MonadIde (ReaderT IdeEnv m) where
-  getRootPath = do
-    mlf <- asks ideEnvLspFuncs
-    case mlf of
-      Just lf -> return (Core.rootPath lf)
-      Nothing -> return Nothing
-
-  getVirtualFile uri = do
-    mlf <- asks ideEnvLspFuncs
-    case mlf of
-      Just lf -> liftIO $ Core.getVirtualFileFunc lf uri
-      Nothing -> return Nothing
-
-  getConfig = do
-    mlf <- asks ideEnvLspFuncs
-    case mlf of
-      Just lf -> fromMaybe def <$> liftIO (Core.config lf)
-      Nothing -> return def
-
-  getClientCapabilities = do
-    mlf <- asks ideEnvLspFuncs
-    case mlf of
-      Just lf -> return (Core.clientCapabilities lf)
-      Nothing -> return def
-
-  getPlugins = asks idePlugins
-
-  withProgress t f = do
-    lf <- asks ideEnvLspFuncs
-    withProgress' lf t f
-
-  withIndefiniteProgress t f = do
-    lf <- asks ideEnvLspFuncs
-    withIndefiniteProgress' lf t f
+class Monad m => MonadIde m where
+  getIdeEnv :: m IdeEnv
 
-instance MonadIde IdeGhcM where
-  getRootPath = lift $ lift getRootPath
-  getVirtualFile = lift . lift . getVirtualFile
-  getConfig = lift $ lift getConfig
-  getClientCapabilities = lift $ lift getClientCapabilities
-  getPlugins = lift $ lift getPlugins
-  withProgress t f = do
-    lf <- lift $ lift $ asks ideEnvLspFuncs
-    withProgress' lf t f
-  withIndefiniteProgress t f = do
-    lf <- lift $ lift $ asks ideEnvLspFuncs
-    withIndefiniteProgress' lf t f
+instance MonadIde IdeM where
+  getIdeEnv = ask
 
 instance MonadIde IdeDeferM where
-  getRootPath = lift getRootPath
-  getVirtualFile = lift . getVirtualFile
-  getConfig = lift getConfig
-  getClientCapabilities = lift getClientCapabilities
-  getPlugins = lift getPlugins
-  withProgress t f = do
-    lf <- lift $ asks ideEnvLspFuncs
-    withProgress' lf t f
-  withIndefiniteProgress t f = do
-    lf <- lift $ asks ideEnvLspFuncs
-    withIndefiniteProgress' lf t f
-
-withProgress' :: MonadIO m => Maybe (Core.LspFuncs Config) -> T.Text -> ((Core.Progress -> m ()) -> m a) -> m a
-withProgress' lspFuncs t f =
-  let mWp = Core.withProgress <$> lspFuncs
-    in case mWp of
-        Nothing -> f (const $ return ())
-        Just wp -> wp t f
-    
-withIndefiniteProgress' :: MonadIO m => Maybe (Core.LspFuncs Config) -> T.Text -> m a -> m a
-withIndefiniteProgress' lspFuncs t f =
-  let mWp = Core.withIndefiniteProgress <$> lspFuncs
-    in case mWp of
-        Nothing -> f
-        Just wp -> wp t f
+  getIdeEnv = lift ask
+
+instance MonadIde IdeGhcM where
+  getIdeEnv = lift $ lift ask
+
+getRootPath :: MonadIde m => m (Maybe FilePath)
+getRootPath = do
+  mlf <- ideEnvLspFuncs <$> getIdeEnv
+  case mlf of
+    Just lf -> return (Core.rootPath lf)
+    Nothing -> return Nothing
+
+getVirtualFile :: (MonadIde m, MonadIO m) => Uri -> m (Maybe VirtualFile)
+getVirtualFile uri = do
+  mlf <- ideEnvLspFuncs <$> getIdeEnv
+  case mlf of
+    Just lf -> liftIO $ Core.getVirtualFileFunc lf uri
+    Nothing -> return Nothing
+
+getConfig :: (MonadIde m, MonadIO m) => m Config
+getConfig = do
+  mlf <- ideEnvLspFuncs <$> getIdeEnv
+  case mlf of
+    Just lf -> fromMaybe def <$> liftIO (Core.config lf)
+    Nothing -> return def
+
+getClientCapabilities :: MonadIde m => m ClientCapabilities
+getClientCapabilities = do
+  mlf <- ideEnvLspFuncs <$> getIdeEnv
+  case mlf of
+    Just lf -> return (Core.clientCapabilities lf)
+    Nothing -> return def
+
+getPlugins :: MonadIde m => m IdePlugins
+getPlugins = idePlugins <$> getIdeEnv
+
+-- | 'withProgress' @title f@ wraps a progress reporting session for long running tasks.
+-- f is passed a reporting function that can be used to give updates on the progress
+-- of the task.
+withProgress :: (MonadIde m, MonadIO m) => T.Text -> ((Core.Progress -> m ()) -> m a) -> m a
+withProgress t f = do
+  lf <- ideEnvLspFuncs <$> getIdeEnv
+  let mWp = Core.withProgress <$> lf
+  case mWp of
+    Nothing -> f (const $ return ())
+    Just wp -> wp t f
+
+-- | 'withIndefiniteProgress' @title f@ is the same as the 'withProgress' but for tasks
+-- which do not continuously report their progress. 
+withIndefiniteProgress :: (MonadIde m, MonadIO m) => T.Text -> m a -> m a
+withIndefiniteProgress t f = do
+  lf <- ideEnvLspFuncs <$> getIdeEnv
+  let mWp = Core.withIndefiniteProgress <$> lf
+  case mWp of
+    Nothing -> f
+    Just wp -> wp t f
 
 data IdeState = IdeState
   { moduleCache :: GhcModuleCache