git.iko.soy/ghcide
on master help sign in
hie-core Logging and exceptions (#1933)

* Rename reportSeriousError to reportInternalError * Stop using logError for logging things that are warnings to the user, not errors by us * Rename logError * Sort the log fields properly * Delete tagAction from Logger * Strip down the pure logger * Delete unused pieces of the logger * A quick check suggests the call stack will be useful in approximately none of the callers of logging, so just remove it * When reporting an internal error, give as much detail as we can * Change our logger to be based on Priority values * HLint fixes * Rename makeNopLogger * In hie-core say what level of message you are setting * Delete the unused makeOneLogger * Make sure we can show messages floating around * If a notification/response handler throws an exception, report it upwards * Remove reportInternalError in favour of a general logging mechanism * Add missing dependencies * Just call fail for a dodgy error report * Add a FIXME * Make missing modules just an error

commit16873edb44e066f4258bc406c4f0dbdef572c4f1 authorNeil Mitchell <35463327+neil-da@users.noreply.github.com> dateFri 28 Jun 2019, 12:47 (7 years ago) parentf70eece
7 files changed+71−29
compare with master
unifiedsplit
BUILD.bazel+1 exe/Main.hs+3−1 hie-core.cabal+1 src/Development/IDE/Core/Shake.hs+6−6 src/Development/IDE/LSP/LanguageServer.hs+22−6 src/Development/IDE/LSP/Server.hs+2−2 src/Development/IDE/Types/Logger.hs+36−14
BUILD.bazel+1
@@ -24,6 +24,7 @@ depends = [
2424 "prettyprinter",
2525 "prettyprinter-ansi-terminal",
2626 "rope-utf16-splay",
27+ "safe-exceptions",
2728 "sorted-list",
2829 "shake",
2930 "stm",
exe/Main.hs+3−1
@@ -22,6 +22,7 @@ import Development.IDE.Types.Location
2222import Development.IDE.Types.Diagnostics
2323import Development.IDE.Types.Options
2424import Development.IDE.Types.Logger
25+import qualified Data.Text as T
2526import qualified Data.Text.IO as T
2627import Language.Haskell.LSP.Messages
2728import Development.IDE.LSP.LanguageServer
@@ -52,7 +53,8 @@ main = do
5253
5354 -- lock to avoid overlapping output on stdout
5455 lock <- newLock
55− let logger = makeOneLogger $ withLock lock . T.putStrLn
56+ let logger = Logger $ \pri msg -> withLock lock $
57+ T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
5658
5759 whenJust argsCwd setCurrentDirectory
5860
hie-core.cabal+1
@@ -111,6 +111,7 @@ executable hie-core
111111 directory,
112112 optparse-applicative,
113113 hie-bios,
114+ safe-exceptions,
114115 shake,
115116 data-default,
116117 ghc-paths,
src/Development/IDE/Core/Shake.hs+6−6
@@ -32,12 +32,12 @@ module Development.IDE.Core.Shake(
3232 use_, uses_,
3333 define, defineEarlyCutoff,
3434 getDiagnostics, unsafeClearDiagnostics,
35− reportSeriousError,
3635 IsIdeGlobal, addIdeGlobal, getIdeGlobalState, getIdeGlobalAction,
3736 garbageCollect,
3837 setPriority,
3938 sendEvent,
4039 ideLogger,
40+ actionLogger,
4141 FileVersion(..)
4242 ) where
4343
@@ -307,11 +307,6 @@ uses_ key files = do
307307 Nothing -> liftIO $ throwIO BadDependency
308308 Just v -> return v
309309
310−reportSeriousError :: String -> Action ()
311−reportSeriousError t = do
312− ShakeExtras{logger} <- getShakeExtras
313− liftIO $ logSeriousError logger $ T.pack t
314−
315310
316311-- | When we depend on something that reported an error, and we fail as a direct result, throw BadDependency
317312-- which short-circuits the rest of the action
@@ -420,6 +415,11 @@ sendEvent e = do
420415ideLogger :: IdeState -> Logger
421416ideLogger IdeState{shakeExtras=ShakeExtras{logger}} = logger
422417
418+actionLogger :: Action Logger
419+actionLogger = do
420+ ShakeExtras{logger} <- getShakeExtras
421+ return logger
422+
423423
424424data GetModificationTime = GetModificationTime
425425 deriving (Eq, Show, Generic)
src/Development/IDE/LSP/LanguageServer.hs+22−6
@@ -17,8 +17,10 @@ import qualified Language.Haskell.LSP.Core as LSP
1717import Control.Concurrent.Chan
1818import Control.Concurrent.Extra
1919import Control.Concurrent.Async
20+import Control.Exception.Safe
2021import Data.Default
2122import Data.Maybe
23+import qualified Data.Text as T
2224import GHC.IO.Handle (hDuplicate, hDuplicateTo)
2325import System.IO
2426import Control.Monad.Extra
@@ -27,6 +29,7 @@ import Development.IDE.LSP.Definition
2729import Development.IDE.LSP.Hover
2830import Development.IDE.LSP.Notifications
2931import Development.IDE.Core.Service
32+import Development.IDE.Types.Logger
3033import Development.IDE.Core.FileStore
3134import Language.Haskell.LSP.Core (LspFuncs(..))
3235import Language.Haskell.LSP.Messages
@@ -89,10 +92,23 @@ runLanguageServer options userHandlers getIdeState = do
8992 _ <- flip forkFinally (const exitClientMsg) $ forever $ do
9093 msg <- readChan clientMsgChan
9194 case msg of
92− Notification NotificationMessage{_params} act -> act ide _params
93− Response RequestMessage{_id, _params} wrap act -> do
94− res <- act ide _params
95− sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
95+ Notification x@NotificationMessage{_params} act -> do
96+ catch (act ide _params) $ \(e :: SomeException) ->
97+ logError (ideLogger ide) $ T.pack $
98+ "Unexpected exception on notification, please report!\n" ++
99+ "Message: " ++ show x ++ "\n" ++
100+ "Exception: " ++ show e
101+ Response x@RequestMessage{_id, _params} wrap act ->
102+ catch (do
103+ res <- act ide _params
104+ sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
105+ ) $ \(e :: SomeException) -> do
106+ logError (ideLogger ide) $ T.pack $
107+ "Unexpected exception on request, please report!\n" ++
108+ "Message: " ++ show x ++ "\n" ++
109+ "Exception: " ++ show e
110+ sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) Nothing $
111+ Just $ ResponseError InternalError (T.pack $ show e) Nothing
96112 pure Nothing
97113
98114
@@ -109,8 +125,8 @@ setHandlersIgnore = PartialHandlers $ \_ x -> return x
109125-- | A message that we need to deal with - the pieces are split up with existentials to gain additional type safety
110126-- and defer precise processing until later (allows us to keep at a higher level of abstraction slightly longer)
111127data Message
112− = forall m req resp . Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (IdeState -> req -> IO resp)
113− | forall m req . Notification (NotificationMessage m req) (IdeState -> req -> IO ())
128+ = forall m req resp . (Show m, Show req) => Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (IdeState -> req -> IO resp)
129+ | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (IdeState -> req -> IO ())
114130
115131
116132modifyOptions :: LSP.Options -> LSP.Options
src/Development/IDE/LSP/Server.hs+2−2
@@ -18,11 +18,11 @@ import Development.IDE.Core.Service
1818
1919
2020data WithMessage = WithMessage
21− {withResponse :: forall m req resp .
21+ {withResponse :: forall m req resp . (Show m, Show req) =>
2222 (ResponseMessage resp -> LSP.FromServerMessage) -> -- how to wrap a response
2323 (IdeState -> req -> IO resp) -> -- actual work
2424 Maybe (LSP.Handler (RequestMessage m req resp))
25− ,withNotification :: forall m req .
25+ ,withNotification :: forall m req . (Show m, Show req) =>
2626 Maybe (LSP.Handler (NotificationMessage m req)) -> -- old notification handler
2727 (IdeState -> req -> IO ()) -> -- actual work
2828 Maybe (LSP.Handler (NotificationMessage m req))
src/Development/IDE/Types/Logger.hs+36−14
@@ -6,23 +6,45 @@
66-- concrete choice of logging framework so users can plug in whatever
77-- framework they want to.
88module Development.IDE.Types.Logger
9− ( Logger(..)
10− , makeOneLogger
11− , makeNopLogger
9+ ( Priority(..)
10+ , Logger(..)
11+ , logError, logWarning, logInfo, logDebug
12+ , noLogging
1213 ) where
1314
1415import qualified Data.Text as T
15−import GHC.Stack
1616
17−data Logger = Logger {
18− logSeriousError :: HasCallStack => T.Text -> IO ()
19− , logInfo :: HasCallStack => T.Text -> IO ()
20− , logDebug :: HasCallStack => T.Text -> IO ()
21− , logWarning :: HasCallStack => T.Text -> IO ()
22− }
2317
24−makeNopLogger :: Logger
25−makeNopLogger = makeOneLogger $ const $ pure ()
18+data Priority
19+-- Don't change the ordering of this type or you will mess up the Ord
20+-- instance
21+ = Debug -- ^ Verbose debug logging.
22+ | Info -- ^ Useful information in case an error has to be understood.
23+ | Warning
24+ -- ^ These error messages should not occur in a expected usage, and
25+ -- should be investigated.
26+ | Error -- ^ Such log messages must never occur in expected usage.
27+ deriving (Eq, Show, Ord, Enum, Bounded)
2628
27−makeOneLogger :: (HasCallStack => T.Text -> IO ()) -> Logger
28−makeOneLogger x = Logger x x x x
29+
30+-- | Note that this is logging actions _of the program_, not of the user.
31+-- You shouldn't call warning/error if the user has caused an error, only
32+-- if our code has gone wrong and is itself erroneous (e.g. we threw an exception).
33+data Logger = Logger {logPriority :: Priority -> T.Text -> IO ()}
34+
35+
36+logError :: Logger -> T.Text -> IO ()
37+logError x = logPriority x Error
38+
39+logWarning :: Logger -> T.Text -> IO ()
40+logWarning x = logPriority x Warning
41+
42+logInfo :: Logger -> T.Text -> IO ()
43+logInfo x = logPriority x Info
44+
45+logDebug :: Logger -> T.Text -> IO ()
46+logDebug x = logPriority x Debug
47+
48+
49+noLogging :: Logger
50+noLogging = Logger $ \_ _ -> return ()