From 30b3fec2f0780c51f5668340400213278d5d4ab0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 6 Mar 2022 14:29:20 +0000 Subject: [PATCH] Adjust rendering of error logs and drop unneeded MonadUnliftIO instance (#2755) * drop unneeded MonadUnliftIO instance * Adjust error message * fixups --- exe/Main.hs | 12 ++++++------ .../IDE/Plugin/LSPWindowShowMessageRecorder.hs | 9 ++++----- ghcide/src/Development/IDE/Types/Logger.hs | 4 ++-- hls-graph/hls-graph.cabal | 1 - .../src/Development/IDE/Graph/Internal/Types.hs | 3 +-- 5 files changed, 13 insertions(+), 16 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 7100c57c71..ef5fdacbed 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -5,6 +5,8 @@ module Main(main) where import Data.Function ((&)) +import Data.Text (Text) +import Development.IDE.Plugin.LSPWindowShowMessageRecorder (makeLspShowMessageRecorder) import Development.IDE.Types.Logger (Priority (Debug, Info, Error), WithPriority (WithPriority, priority), cfilter, cmapWithPrio, @@ -15,11 +17,9 @@ import Ide.Arguments (Arguments (..), getArguments) import Ide.Main (defaultMain) import qualified Ide.Main as IdeMain +import Ide.PluginUtils (pluginDescToIdePlugins) import qualified Plugins -import Prettyprinter (Pretty (pretty), vcat) -import Development.IDE.Plugin.LSPWindowShowMessageRecorder (makeLspShowMessageRecorder) -import Data.Text (Text) -import Ide.PluginUtils (pluginDescToIdePlugins) +import Prettyprinter (Pretty (pretty), vsep) data Log = LogIdeMain IdeMain.Log @@ -59,8 +59,8 @@ main = do defaultMain (cmapWithPrio LogIdeMain recorder) args (pluginDescToIdePlugins [lspRecorderPlugin] <> plugins) renderDoc :: Doc a -> Text -renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vcat - ["Unhandled exception, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): " +renderDoc d = renderStrict $ layoutPretty defaultLayoutOptions $ vsep + ["Error condition, please check your setup and/or the [issue tracker](" <> issueTrackerUrl <> "): " ,d ] diff --git a/ghcide/src/Development/IDE/Plugin/LSPWindowShowMessageRecorder.hs b/ghcide/src/Development/IDE/Plugin/LSPWindowShowMessageRecorder.hs index fb583a377a..213c5849d0 100644 --- a/ghcide/src/Development/IDE/Plugin/LSPWindowShowMessageRecorder.hs +++ b/ghcide/src/Development/IDE/Plugin/LSPWindowShowMessageRecorder.hs @@ -3,7 +3,6 @@ module Development.IDE.Plugin.LSPWindowShowMessageRecorder (makeLspShowMessageRecorder) where import Control.Monad.IO.Class -import Control.Monad.IO.Unlift (MonadUnliftIO) import Data.Foldable (for_) import Data.IORef import Data.IORef.Extra (atomicModifyIORef'_) @@ -24,8 +23,8 @@ makeLspShowMessageRecorder = do backLogRef <- newIORef [] let recorder = Recorder $ \it -> do mbenv <- liftIO $ readIORef envRef - case mbenv of - Nothing -> liftIO $ atomicModifyIORef'_ backLogRef (it :) + liftIO $ case mbenv of + Nothing -> atomicModifyIORef'_ backLogRef (it :) Just env -> sendMsg env it -- the plugin captures the language context, so it can be used to send messages plugin = @@ -35,11 +34,11 @@ makeLspShowMessageRecorder = do liftIO $ writeIORef envRef $ Just env -- flush the backlog backLog <- liftIO $ atomicModifyIORef' backLogRef ([],) - for_ (reverse backLog) $ sendMsg env + liftIO $ for_ (reverse backLog) $ sendMsg env } return (recorder, plugin) -sendMsg :: MonadUnliftIO m => LanguageContextEnv config -> WithPriority Text -> m () +sendMsg :: LanguageContextEnv config -> WithPriority Text -> IO () sendMsg env WithPriority {..} = LSP.runLspT env $ LSP.sendNotification diff --git a/ghcide/src/Development/IDE/Types/Logger.hs b/ghcide/src/Development/IDE/Types/Logger.hs index 264435b364..35582cdccd 100644 --- a/ghcide/src/Development/IDE/Types/Logger.hs +++ b/ghcide/src/Development/IDE/Types/Logger.hs @@ -97,9 +97,9 @@ data WithPriority a = WithPriority { priority :: Priority, callStack_ :: CallSta -- You shouldn't call warning/error if the user has caused an error, only -- if our code has gone wrong and is itself erroneous (e.g. we threw an exception). newtype Recorder msg = Recorder - { logger_ :: forall m. (MonadUnliftIO m) => msg -> m () } + { logger_ :: forall m. (MonadIO m) => msg -> m () } -logWith :: (HasCallStack, MonadUnliftIO m) => Recorder (WithPriority msg) -> Priority -> msg -> m () +logWith :: (HasCallStack, MonadIO m) => Recorder (WithPriority msg) -> Priority -> msg -> m () logWith recorder priority msg = withFrozenCallStack $ logger_ recorder (WithPriority priority callStack msg) instance Semigroup (Recorder msg) where diff --git a/hls-graph/hls-graph.cabal b/hls-graph/hls-graph.cabal index cee9a3c7b9..c31c3dd755 100644 --- a/hls-graph/hls-graph.cabal +++ b/hls-graph/hls-graph.cabal @@ -81,7 +81,6 @@ library , stm-containers , time , transformers - , unliftio , unordered-containers if flag(embed-files) diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 5cb6937861..0a1278f5d3 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -36,7 +36,6 @@ import qualified ListT import StmContainers.Map (Map) import qualified StmContainers.Map as SMap import System.Time.Extra (Seconds) -import UnliftIO (MonadUnliftIO) unwrapDynamic :: forall a . Typeable a => Dynamic -> a @@ -63,7 +62,7 @@ data SRules = SRules { -- ACTIONS newtype Action a = Action {fromAction :: ReaderT SAction IO a} - deriving newtype (Monad, Applicative, Functor, MonadIO, MonadFail, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO) + deriving newtype (Monad, Applicative, Functor, MonadIO, MonadFail, MonadThrow, MonadCatch, MonadMask) data SAction = SAction { actionDatabase :: !Database,