{-# LANGUAGE OverloadedStrings #-}

module Ide.Plugin.HandleRequestTypes where

import           Data.Text
import           Prettyprinter

-- | Reasons why a plugin could reject a specific request.
data RejectionReason =
  -- | The resolve request is not meant for this plugin or handler. The text
  -- field should contain the identifier for the plugin who owns this resolve
  -- request.
  NotResolveOwner Text
  -- | The plugin is disabled globally in the users config.
  | DisabledGlobally
  -- | The feature in the plugin that responds to this request is disabled in
  -- the users config
  | FeatureDisabled
  -- | This plugin is not the formatting provider selected in the users config.
  -- The text should be the formatting provider in your config.
  | NotFormattingProvider Text
  -- | This plugin does not support the file type. The text field here should
  -- contain the filetype of the rejected request.
  | DoesNotSupportFileType Text
  deriving (RejectionReason -> RejectionReason -> Bool
(RejectionReason -> RejectionReason -> Bool)
-> (RejectionReason -> RejectionReason -> Bool)
-> Eq RejectionReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RejectionReason -> RejectionReason -> Bool
== :: RejectionReason -> RejectionReason -> Bool
$c/= :: RejectionReason -> RejectionReason -> Bool
/= :: RejectionReason -> RejectionReason -> Bool
Eq)

-- | Whether a plugin will handle a request or not.
data HandleRequestResult = HandlesRequest | DoesNotHandleRequest RejectionReason
  deriving (HandleRequestResult -> HandleRequestResult -> Bool
(HandleRequestResult -> HandleRequestResult -> Bool)
-> (HandleRequestResult -> HandleRequestResult -> Bool)
-> Eq HandleRequestResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HandleRequestResult -> HandleRequestResult -> Bool
== :: HandleRequestResult -> HandleRequestResult -> Bool
$c/= :: HandleRequestResult -> HandleRequestResult -> Bool
/= :: HandleRequestResult -> HandleRequestResult -> Bool
Eq)

instance Pretty HandleRequestResult where
  pretty :: forall ann. HandleRequestResult -> Doc ann
pretty HandleRequestResult
HandlesRequest                = Doc ann
"handles this request"
  pretty (DoesNotHandleRequest RejectionReason
reason) = RejectionReason -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. RejectionReason -> Doc ann
pretty RejectionReason
reason

instance Pretty RejectionReason where
  pretty :: forall ann. RejectionReason -> Doc ann
pretty (NotResolveOwner Text
s) = Doc ann
"does not handle resolve requests for " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")."
  pretty RejectionReason
DisabledGlobally = Doc ann
"is disabled globally in your config."
  pretty RejectionReason
FeatureDisabled = Doc ann
"'s feature that handles this request is disabled in your config."
  pretty (NotFormattingProvider Text
s) = Doc ann
"is not the formatting provider ("Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
sDoc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>Doc ann
") you chose in your config."
  pretty (DoesNotSupportFileType Text
s) = Doc ann
"does not support " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" filetypes)."

-- We always want to keep the leftmost disabled reason
instance Semigroup HandleRequestResult where
  HandleRequestResult
HandlesRequest <> :: HandleRequestResult -> HandleRequestResult -> HandleRequestResult
<> HandleRequestResult
HandlesRequest = HandleRequestResult
HandlesRequest
  DoesNotHandleRequest RejectionReason
r <> HandleRequestResult
_      = RejectionReason -> HandleRequestResult
DoesNotHandleRequest RejectionReason
r
  HandleRequestResult
_ <> DoesNotHandleRequest RejectionReason
r      = RejectionReason -> HandleRequestResult
DoesNotHandleRequest RejectionReason
r