{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Error (
      -- * Plugin Error Handling API
    PluginError(..),
    toErrorCode,
    toPriority,
    handleMaybe,
    handleMaybeM,
    getNormalizedFilePathE,
) where

import           Control.Monad.Extra           (maybeM)
import           Control.Monad.Trans.Class     (lift)
import           Control.Monad.Trans.Except    (ExceptT (..), throwE)
import qualified Data.Text                     as T
import           Ide.Logger
import           Ide.Plugin.HandleRequestTypes (RejectionReason)
import           Language.LSP.Protocol.Types

-- ----------------------------------------------------------------------------
-- Plugin Error wrapping
-- ----------------------------------------------------------------------------

-- |Each PluginError corresponds to either a specific ResponseError we want to
-- return or a specific way we want to log the error. If the currently present
-- ones are insufficient for the needs of your plugin, please feel free to add
-- a new one.
--
-- Currently the PluginErrors we provide can be broken up into several groups.
-- First is PluginInternalError, which is the most serious of the errors, and
-- also the "default" error that is used for things such as uncaught exceptions.
-- Then we have PluginInvalidParams, which along with PluginInternalError map
-- to a corresponding ResponseError.
--
-- Next we have PluginRuleFailed and PluginInvalidUserState, with the only
-- difference being PluginRuleFailed is specific to Shake rules and
-- PluginInvalidUserState can be used for everything else. Both of these are
-- "non-errors", and happen whenever the user's code is in a state where the
-- plugin is unable to provide a answer to the users request. PluginStaleResolve
-- is similar to the above two Error types, but is specific to resolve plugins,
-- and is used only when the data provided by the resolve request is stale,
-- preventing the proper resolution of it.
--
-- Finally we have the outlier, PluginRequestRefused, where we allow a handler
-- to preform "pluginEnabled" checks inside the handler, and reject the request
-- after viewing it. The behavior of only one handler passing `pluginEnabled`
-- and then returning PluginRequestRefused should be the same as if no plugins
-- passed the `pluginEnabled` stage.
data PluginError
  = -- |PluginInternalError should be used if an error has occurred. This
    -- should only rarely be returned. As it's logged with Error, it will be
    -- shown by the client to the user via `showWindow`. All uncaught exceptions
    -- will be caught and converted to this error.
    --
    -- This error will be be converted into an InternalError response code. It
    -- will be logged with Error and takes the highest precedence (1) in being
    -- returned as a response to the client.
    PluginInternalError T.Text
    -- |PluginInvalidParams should be used if the parameters of the request are
    -- invalid. This error means that there is a bug in the client's code
    -- (otherwise they wouldn't be sending you requests with invalid
    -- parameters).
    --
    -- This error will be will be converted into a InvalidParams response code.
    -- It will be logged with Warning and takes medium precedence (2) in being
    -- returned as a response to the client.
  | PluginInvalidParams T.Text
    -- |PluginInvalidUserState should be thrown when a function that your plugin
    -- depends on fails. This should only be used when the function fails
    -- because the user's code is in an invalid state.
    --
    -- This error takes the name of the function that failed. Prefer to catch
    -- this error as close to the source as possible.
    --
    -- This error will be logged with Debug, and will be converted into a
    -- RequestFailed response. It takes a low precedence (3) in being returned
    -- as a response to the client.
  | PluginInvalidUserState T.Text
    -- |PluginRequestRefused allows your handler to inspect a request before
    -- rejecting it. In effect it allows your plugin to act make a secondary
    -- `handlesRequest` decision after receiving the request. This should only be
    -- used if the decision to accept the request can not be made in
    -- `handlesRequest`.
    --
    -- This error will be with Debug. If it's the only response to a request,
    -- HLS will respond as if no plugins passed the `handlesRequest` stage.
  | PluginRequestRefused RejectionReason
    -- |PluginRuleFailed should be thrown when a Rule your response depends on
    -- fails.
    --
    -- This error takes the name of the Rule that failed.
    --
    -- This error will be logged with Debug, and will be converted into a
    -- RequestFailed response code. It takes a low precedence (3) in being
    -- returned as a response to the client.
  | PluginRuleFailed T.Text
    -- |PluginStaleResolve should be thrown when your resolve request is
    -- provided with data it can no longer resolve.
    --
    -- This error will be logged with Debug, and will be converted into a
    -- ContentModified response. It takes a low precedence (3) in being returned
    -- as a response to the client.
  | PluginStaleResolve

instance Pretty PluginError where
    pretty :: forall ann. PluginError -> Doc ann
pretty = \case
      PluginInternalError Text
msg     -> Doc ann
"Internal Error:"     Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
msg
      PluginError
PluginStaleResolve          -> Doc ann
"Stale Resolve"
      PluginRuleFailed Text
rule       -> Doc ann
"Rule Failed:"        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
rule
      PluginInvalidParams Text
text    -> Doc ann
"Invalid Params:"     Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
text
      PluginInvalidUserState Text
text -> Doc ann
"Invalid User State:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
text
      PluginRequestRefused RejectionReason
msg    -> Doc ann
"Request Refused: "   Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> RejectionReason -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. RejectionReason -> Doc ann
pretty RejectionReason
msg

-- |Converts to ErrorCode used in LSP ResponseErrors
toErrorCode :: PluginError -> (LSPErrorCodes |? ErrorCodes)
toErrorCode :: PluginError -> LSPErrorCodes |? ErrorCodes
toErrorCode (PluginInternalError Text
_)    = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InternalError
toErrorCode (PluginInvalidParams Text
_)    = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidParams
toErrorCode (PluginInvalidUserState Text
_) = LSPErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. a -> a |? b
InL LSPErrorCodes
LSPErrorCodes_RequestFailed
-- PluginRequestRefused should never be a argument to `toResponseError`, as
-- it should be dealt with in `extensiblePlugins`, but this is here to make
-- this function complete
toErrorCode (PluginRequestRefused RejectionReason
_)   = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_MethodNotFound
toErrorCode (PluginRuleFailed Text
_)       = LSPErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. a -> a |? b
InL LSPErrorCodes
LSPErrorCodes_RequestFailed
toErrorCode PluginError
PluginStaleResolve         = LSPErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. a -> a |? b
InL LSPErrorCodes
LSPErrorCodes_ContentModified

-- |Converts to a logging priority. In addition to being used by the logger,
-- `combineResponses` currently uses this to  choose which response to return,
-- so care should be taken in changing it.
toPriority :: PluginError -> Priority
toPriority :: PluginError -> Priority
toPriority (PluginInternalError Text
_)    = Priority
Error
toPriority (PluginInvalidParams Text
_)    = Priority
Warning
toPriority (PluginInvalidUserState Text
_) = Priority
Debug
toPriority (PluginRequestRefused RejectionReason
_)   = Priority
Debug
toPriority (PluginRuleFailed Text
_)       = Priority
Debug
toPriority PluginError
PluginStaleResolve         = Priority
Debug

handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe :: forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe e
msg = ExceptT e m b -> (b -> ExceptT e m b) -> Maybe b -> ExceptT e m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall a. a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return

handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
handleMaybeM :: forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM e
msg m (Maybe b)
act = ExceptT e m b
-> (b -> ExceptT e m b) -> ExceptT e m (Maybe b) -> ExceptT e m b
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall a. a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT e m (Maybe b) -> ExceptT e m b)
-> ExceptT e m (Maybe b) -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$ m (Maybe b) -> ExceptT e m (Maybe b)
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe b)
act

getNormalizedFilePathE :: Monad m => Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE :: forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri = PluginError
-> Maybe NormalizedFilePath
-> ExceptT PluginError m NormalizedFilePath
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe (Text -> PluginError
PluginInvalidParams (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"uriToNormalizedFile failed. Uri:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  Uri -> String
forall a. Show a => a -> String
show Uri
uri))
        (Maybe NormalizedFilePath
 -> ExceptT PluginError m NormalizedFilePath)
-> Maybe NormalizedFilePath
-> ExceptT PluginError m NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath
        (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri