{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Error (
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
data PluginError
=
PluginInternalError T.Text
| PluginInvalidParams T.Text
| PluginInvalidUserState T.Text
| PluginRequestRefused RejectionReason
| PluginRuleFailed T.Text
| 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
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
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
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