{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.LSP.Types.Progress where
import Control.Applicative
import Control.Monad (unless)
import qualified Data.Aeson as A
import Data.Aeson.TH
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Language.LSP.Types.Utils
data ProgressToken
= ProgressNumericToken Int
| ProgressTextToken Text
deriving (Show, Read, Eq, Ord)
instance A.ToJSON ProgressToken where
toJSON (ProgressNumericToken i) = A.toJSON i
toJSON (ProgressTextToken t) = A.toJSON t
instance A.FromJSON ProgressToken where
parseJSON (A.String t) = pure $ ProgressTextToken t
parseJSON (A.Number i) = ProgressNumericToken <$> A.parseJSON (A.Number i)
parseJSON v = fail $ "Invalid progress token: " ++ show v
data ProgressParams t =
ProgressParams {
_token :: ProgressToken
, _value :: t
} deriving (Show, Read, Eq, Functor)
deriveJSON lspOptions ''ProgressParams
data SomeProgressParams
= Begin WorkDoneProgressBeginParams
| Report WorkDoneProgressReportParams
| End WorkDoneProgressEndParams
deriving Eq
instance A.FromJSON SomeProgressParams where
parseJSON x =
(Begin <$> A.parseJSON x)
<|> (Report <$> A.parseJSON x)
<|> (End <$> A.parseJSON x)
instance A.ToJSON SomeProgressParams where
toJSON (Begin x) = A.toJSON x
toJSON (Report x) = A.toJSON x
toJSON (End x) = A.toJSON x
data WorkDoneProgressBeginParams =
WorkDoneProgressBeginParams {
_title :: Text
, _cancellable :: Maybe Bool
, _message :: Maybe Text
, _percentage :: Maybe Double
} deriving (Show, Read, Eq)
instance A.ToJSON WorkDoneProgressBeginParams where
toJSON WorkDoneProgressBeginParams{..} =
A.object $ catMaybes
[ Just $ "kind" A..= ("begin" :: Text)
, Just $ "title" A..= _title
, ("cancellable" A..=) <$> _cancellable
, ("message" A..=) <$> _message
, ("percentage" A..=) <$> _percentage
]
instance A.FromJSON WorkDoneProgressBeginParams where
parseJSON = A.withObject "WorkDoneProgressBegin" $ \o -> do
kind <- o A..: "kind"
unless (kind == ("begin" :: Text)) $ fail $ "Expected kind \"begin\" but got " ++ show kind
_title <- o A..: "title"
_cancellable <- o A..:? "cancellable"
_message <- o A..:? "message"
_percentage <- o A..:? "percentage"
pure WorkDoneProgressBeginParams{..}
data WorkDoneProgressReportParams =
WorkDoneProgressReportParams {
_cancellable :: Maybe Bool
, _message :: Maybe Text
, _percentage :: Maybe Double
} deriving (Show, Read, Eq)
instance A.ToJSON WorkDoneProgressReportParams where
toJSON WorkDoneProgressReportParams{..} =
A.object $ catMaybes
[ Just $ "kind" A..= ("report" :: Text)
, ("cancellable" A..=) <$> _cancellable
, ("message" A..=) <$> _message
, ("percentage" A..=) <$> _percentage
]
instance A.FromJSON WorkDoneProgressReportParams where
parseJSON = A.withObject "WorkDoneProgressReport" $ \o -> do
kind <- o A..: "kind"
unless (kind == ("report" :: Text)) $ fail $ "Expected kind \"report\" but got " ++ show kind
_cancellable <- o A..:? "cancellable"
_message <- o A..:? "message"
_percentage <- o A..:? "percentage"
pure WorkDoneProgressReportParams{..}
data WorkDoneProgressEndParams =
WorkDoneProgressEndParams {
_message :: Maybe Text
} deriving (Show, Read, Eq)
instance A.ToJSON WorkDoneProgressEndParams where
toJSON WorkDoneProgressEndParams{..} =
A.object $ catMaybes
[ Just $ "kind" A..= ("end" :: Text)
, ("message" A..=) <$> _message
]
instance A.FromJSON WorkDoneProgressEndParams where
parseJSON = A.withObject "WorkDoneProgressEnd" $ \o -> do
kind <- o A..: "kind"
unless (kind == ("end" :: Text)) $ fail $ "Expected kind \"end\" but got " ++ show kind
_message <- o A..:? "message"
pure WorkDoneProgressEndParams{..}
data WorkDoneProgressCancelParams =
WorkDoneProgressCancelParams {
_token :: ProgressToken
} deriving (Show, Read, Eq)
deriveJSON lspOptions ''WorkDoneProgressCancelParams
data WorkDoneProgressCreateParams =
WorkDoneProgressCreateParams {
_token :: ProgressToken
} deriving (Show, Read, Eq)
deriveJSON lspOptions ''WorkDoneProgressCreateParams
data WorkDoneProgressOptions =
WorkDoneProgressOptions
{ _workDoneProgress :: Maybe Bool
}
deriving (Read, Show, Eq)
deriveJSON lspOptions ''WorkDoneProgressOptions
data WorkDoneProgressParams =
WorkDoneProgressParams
{
_workDoneToken :: Maybe ProgressToken
} deriving (Read,Show,Eq)
deriveJSON lspOptions ''WorkDoneProgressParams
data PartialResultParams =
PartialResultParams
{
_partialResultToken :: Maybe ProgressToken
} deriving (Read,Show,Eq)
deriveJSON lspOptions ''PartialResultParams