{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Language.LSP.Types.DocumentColor where

import Data.Aeson.TH
import Data.Text (Text)
import Language.LSP.Types.Common
import Language.LSP.Types.Location
import Language.LSP.Types.Progress
import Language.LSP.Types.StaticRegistrationOptions
import Language.LSP.Types.TextDocument
import Language.LSP.Types.Utils
import Language.LSP.Types.WorkspaceEdit

data DocumentColorClientCapabilities =
  DocumentColorClientCapabilities
  { -- | Whether document color supports dynamic registration.
    DocumentColorClientCapabilities -> Maybe Bool
_dynamicRegistration :: Maybe Bool
  } deriving (ReadPrec [DocumentColorClientCapabilities]
ReadPrec DocumentColorClientCapabilities
Int -> ReadS DocumentColorClientCapabilities
ReadS [DocumentColorClientCapabilities]
(Int -> ReadS DocumentColorClientCapabilities)
-> ReadS [DocumentColorClientCapabilities]
-> ReadPrec DocumentColorClientCapabilities
-> ReadPrec [DocumentColorClientCapabilities]
-> Read DocumentColorClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentColorClientCapabilities]
$creadListPrec :: ReadPrec [DocumentColorClientCapabilities]
readPrec :: ReadPrec DocumentColorClientCapabilities
$creadPrec :: ReadPrec DocumentColorClientCapabilities
readList :: ReadS [DocumentColorClientCapabilities]
$creadList :: ReadS [DocumentColorClientCapabilities]
readsPrec :: Int -> ReadS DocumentColorClientCapabilities
$creadsPrec :: Int -> ReadS DocumentColorClientCapabilities
Read, Int -> DocumentColorClientCapabilities -> ShowS
[DocumentColorClientCapabilities] -> ShowS
DocumentColorClientCapabilities -> String
(Int -> DocumentColorClientCapabilities -> ShowS)
-> (DocumentColorClientCapabilities -> String)
-> ([DocumentColorClientCapabilities] -> ShowS)
-> Show DocumentColorClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentColorClientCapabilities] -> ShowS
$cshowList :: [DocumentColorClientCapabilities] -> ShowS
show :: DocumentColorClientCapabilities -> String
$cshow :: DocumentColorClientCapabilities -> String
showsPrec :: Int -> DocumentColorClientCapabilities -> ShowS
$cshowsPrec :: Int -> DocumentColorClientCapabilities -> ShowS
Show, DocumentColorClientCapabilities
-> DocumentColorClientCapabilities -> Bool
(DocumentColorClientCapabilities
 -> DocumentColorClientCapabilities -> Bool)
-> (DocumentColorClientCapabilities
    -> DocumentColorClientCapabilities -> Bool)
-> Eq DocumentColorClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentColorClientCapabilities
-> DocumentColorClientCapabilities -> Bool
$c/= :: DocumentColorClientCapabilities
-> DocumentColorClientCapabilities -> Bool
== :: DocumentColorClientCapabilities
-> DocumentColorClientCapabilities -> Bool
$c== :: DocumentColorClientCapabilities
-> DocumentColorClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''DocumentColorClientCapabilities

-- -------------------------------------

makeExtendingDatatype "DocumentColorOptions" [''WorkDoneProgressOptions] []
deriveJSON lspOptions ''DocumentColorOptions

makeExtendingDatatype "DocumentColorRegistrationOptions"
  [ ''TextDocumentRegistrationOptions
  , ''StaticRegistrationOptions
  , ''DocumentColorOptions
  ] []
deriveJSON lspOptions ''DocumentColorRegistrationOptions

-- -------------------------------------

makeExtendingDatatype "DocumentColorParams"
  [ ''WorkDoneProgressParams
  , ''PartialResultParams
  ]
  [("_textDocument", [t| TextDocumentIdentifier |])]
deriveJSON lspOptions ''DocumentColorParams

-- -------------------------------------

-- | Represents a color in RGBA space.
data Color =
  Color
    { Color -> Int
_red   :: Int -- ^ The red component of this color in the range [0-1].
    , Color -> Int
_green :: Int -- ^ The green component of this color in the range [0-1].
    , Color -> Int
_blue  :: Int -- ^ The blue component of this color in the range [0-1].
    , Color -> Int
_alpha :: Int -- ^ The alpha component of this color in the range [0-1].
    } deriving (ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Color]
$creadListPrec :: ReadPrec [Color]
readPrec :: ReadPrec Color
$creadPrec :: ReadPrec Color
readList :: ReadS [Color]
$creadList :: ReadS [Color]
readsPrec :: Int -> ReadS Color
$creadsPrec :: Int -> ReadS Color
Read, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq)
deriveJSON lspOptions ''Color

data ColorInformation =
  ColorInformation
    { ColorInformation -> Range
_range :: Range -- ^ The range in the document where this color appears.
    , ColorInformation -> Color
_color :: Color -- ^ The actual color value for this color range.
    } deriving (ReadPrec [ColorInformation]
ReadPrec ColorInformation
Int -> ReadS ColorInformation
ReadS [ColorInformation]
(Int -> ReadS ColorInformation)
-> ReadS [ColorInformation]
-> ReadPrec ColorInformation
-> ReadPrec [ColorInformation]
-> Read ColorInformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorInformation]
$creadListPrec :: ReadPrec [ColorInformation]
readPrec :: ReadPrec ColorInformation
$creadPrec :: ReadPrec ColorInformation
readList :: ReadS [ColorInformation]
$creadList :: ReadS [ColorInformation]
readsPrec :: Int -> ReadS ColorInformation
$creadsPrec :: Int -> ReadS ColorInformation
Read, Int -> ColorInformation -> ShowS
[ColorInformation] -> ShowS
ColorInformation -> String
(Int -> ColorInformation -> ShowS)
-> (ColorInformation -> String)
-> ([ColorInformation] -> ShowS)
-> Show ColorInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorInformation] -> ShowS
$cshowList :: [ColorInformation] -> ShowS
show :: ColorInformation -> String
$cshow :: ColorInformation -> String
showsPrec :: Int -> ColorInformation -> ShowS
$cshowsPrec :: Int -> ColorInformation -> ShowS
Show, ColorInformation -> ColorInformation -> Bool
(ColorInformation -> ColorInformation -> Bool)
-> (ColorInformation -> ColorInformation -> Bool)
-> Eq ColorInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorInformation -> ColorInformation -> Bool
$c/= :: ColorInformation -> ColorInformation -> Bool
== :: ColorInformation -> ColorInformation -> Bool
$c== :: ColorInformation -> ColorInformation -> Bool
Eq)
deriveJSON lspOptions ''ColorInformation

-- -------------------------------------

makeExtendingDatatype "ColorPresentationParams"
  [ ''WorkDoneProgressParams
  , ''PartialResultParams
  ]
  [ ("_textDocument", [t| TextDocumentIdentifier |])
  , ("_color", [t| Color |])
  , ("_range", [t| Range |])
  ]
deriveJSON lspOptions ''ColorPresentationParams

-- -------------------------------------

data ColorPresentation =
  ColorPresentation
    { -- | The label of this color presentation. It will be shown on the color
      -- picker header. By default this is also the text that is inserted when selecting
      -- this color presentation.
      ColorPresentation -> Text
_label               :: Text
      -- | A 'TextEdit' which is applied to a document when selecting
      -- this presentation for the color.  When `falsy` the '_label'
      -- is used.
    , ColorPresentation -> Maybe TextEdit
_textEdit            :: Maybe TextEdit
      -- | An optional array of additional 'TextEdit's that are applied when
      -- selecting this color presentation. Edits must not overlap with the main
      -- '_textEdit' nor with themselves.
    , ColorPresentation -> Maybe (List TextEdit)
_additionalTextEdits :: Maybe (List TextEdit)
    } deriving (ReadPrec [ColorPresentation]
ReadPrec ColorPresentation
Int -> ReadS ColorPresentation
ReadS [ColorPresentation]
(Int -> ReadS ColorPresentation)
-> ReadS [ColorPresentation]
-> ReadPrec ColorPresentation
-> ReadPrec [ColorPresentation]
-> Read ColorPresentation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorPresentation]
$creadListPrec :: ReadPrec [ColorPresentation]
readPrec :: ReadPrec ColorPresentation
$creadPrec :: ReadPrec ColorPresentation
readList :: ReadS [ColorPresentation]
$creadList :: ReadS [ColorPresentation]
readsPrec :: Int -> ReadS ColorPresentation
$creadsPrec :: Int -> ReadS ColorPresentation
Read, Int -> ColorPresentation -> ShowS
[ColorPresentation] -> ShowS
ColorPresentation -> String
(Int -> ColorPresentation -> ShowS)
-> (ColorPresentation -> String)
-> ([ColorPresentation] -> ShowS)
-> Show ColorPresentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorPresentation] -> ShowS
$cshowList :: [ColorPresentation] -> ShowS
show :: ColorPresentation -> String
$cshow :: ColorPresentation -> String
showsPrec :: Int -> ColorPresentation -> ShowS
$cshowsPrec :: Int -> ColorPresentation -> ShowS
Show, ColorPresentation -> ColorPresentation -> Bool
(ColorPresentation -> ColorPresentation -> Bool)
-> (ColorPresentation -> ColorPresentation -> Bool)
-> Eq ColorPresentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorPresentation -> ColorPresentation -> Bool
$c/= :: ColorPresentation -> ColorPresentation -> Bool
== :: ColorPresentation -> ColorPresentation -> Bool
$c== :: ColorPresentation -> ColorPresentation -> Bool
Eq)
deriveJSON lspOptions ''ColorPresentation