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

import           Data.Aeson.TH
import           Data.Text                      ( Text )
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.Progress
import           Language.Haskell.LSP.Types.TextDocument
import           Language.Haskell.LSP.Types.WorkspaceEdit

{-
Document Color Request (:leftwards_arrow_with_hook:)
Since version 3.6.0

The document color request is sent from the client to the server to list all
color references found in a given text document. Along with the range, a color
value in RGB is returned.

Clients can use the result to decorate color references in an editor. For example:

Color boxes showing the actual color next to the reference
Show a color picker when a color reference is edited
Request:

method: ‘textDocument/documentColor’
params: DocumentColorParams defined as follows
interface DocumentColorParams {
	/**
	 * The text document.
	 */
	textDocument: TextDocumentIdentifier;
}
Response:

result: ColorInformation[] defined as follows:
interface ColorInformation {
	/**
	 * The range in the document where this color appears.
	 */
	range: Range;

	/**
	 * The actual color value for this color range.
	 */
	color: Color;
}

/**
 * Represents a color in RGBA space.
 */
interface Color {

	/**
	 * The red component of this color in the range [0-1].
	 */
	readonly red: number;

	/**
	 * The green component of this color in the range [0-1].
	 */
	readonly green: number;

	/**
	 * The blue component of this color in the range [0-1].
	 */
	readonly blue: number;

	/**
	 * The alpha component of this color in the range [0-1].
	 */
	readonly alpha: number;
}
error: code and message set in case an exception happens during the
‘textDocument/documentColor’ request
-}

-- | 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

data DocumentColorParams =
  DocumentColorParams
    { DocumentColorParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier -- ^ The text document.
    , DocumentColorParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (ReadPrec [DocumentColorParams]
ReadPrec DocumentColorParams
Int -> ReadS DocumentColorParams
ReadS [DocumentColorParams]
(Int -> ReadS DocumentColorParams)
-> ReadS [DocumentColorParams]
-> ReadPrec DocumentColorParams
-> ReadPrec [DocumentColorParams]
-> Read DocumentColorParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentColorParams]
$creadListPrec :: ReadPrec [DocumentColorParams]
readPrec :: ReadPrec DocumentColorParams
$creadPrec :: ReadPrec DocumentColorParams
readList :: ReadS [DocumentColorParams]
$creadList :: ReadS [DocumentColorParams]
readsPrec :: Int -> ReadS DocumentColorParams
$creadsPrec :: Int -> ReadS DocumentColorParams
Read, Int -> DocumentColorParams -> ShowS
[DocumentColorParams] -> ShowS
DocumentColorParams -> String
(Int -> DocumentColorParams -> ShowS)
-> (DocumentColorParams -> String)
-> ([DocumentColorParams] -> ShowS)
-> Show DocumentColorParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentColorParams] -> ShowS
$cshowList :: [DocumentColorParams] -> ShowS
show :: DocumentColorParams -> String
$cshow :: DocumentColorParams -> String
showsPrec :: Int -> DocumentColorParams -> ShowS
$cshowsPrec :: Int -> DocumentColorParams -> ShowS
Show, DocumentColorParams -> DocumentColorParams -> Bool
(DocumentColorParams -> DocumentColorParams -> Bool)
-> (DocumentColorParams -> DocumentColorParams -> Bool)
-> Eq DocumentColorParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentColorParams -> DocumentColorParams -> Bool
$c/= :: DocumentColorParams -> DocumentColorParams -> Bool
== :: DocumentColorParams -> DocumentColorParams -> Bool
$c== :: DocumentColorParams -> DocumentColorParams -> Bool
Eq)

deriveJSON lspOptions ''DocumentColorParams

type DocumentColorRequest =
  RequestMessage ClientMethod DocumentColorParams (List ColorInformation)
type DocumentColorResponse = ResponseMessage (List ColorInformation)

{-
Color Presentation Request (:leftwards_arrow_with_hook:)
Since version 3.6.0

The color presentation request is sent from the client to the server to obtain a list of
presentations for a color value at a given location. Clients can use the result to

modify a color reference.
show in a color picker and let users pick one of the presentations
Request:

method: ‘textDocument/colorPresentation’
params: DocumentColorParams defined as follows
interface ColorPresentationParams {
	/**
	 * The text document.
	 */
	textDocument: TextDocumentIdentifier;

	/**
	 * The color information to request presentations for.
	 */
	color: Color;

	/**
	 * The range where the color would be inserted. Serves as a context.
	 */
	range: Range;
}
Response:

result: ColorPresentation[] defined as follows:
interface 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.
	 */
	label: string;
	/**
	 * An [edit](#TextEdit) which is applied to a document when selecting
         * this presentation for the color.
         * When `falsy` the [label](#ColorPresentation.label) is used.
	 */
	textEdit?: TextEdit;
	/**
	 * An optional array of additional [text edits](#TextEdit) that are applied when
         * selecting this color presentation. Edits must not overlap with the main
         * [edit](#ColorPresentation.textEdit) nor with themselves.
	 */
	additionalTextEdits?: TextEdit[];
}
error: code and message set in case an exception happens during the 
‘textDocument/colorPresentation’ request
-}

data ColorPresentationParams =
  ColorPresentationParams
    { -- | The text document.
      ColorPresentationParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
      -- | The color information to request presentations for.
    , ColorPresentationParams -> Color
_color        :: Color
      -- | The range where the color would be inserted.
      -- Serves as a context.
    , ColorPresentationParams -> Range
_range        :: Range
    , ColorPresentationParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (ReadPrec [ColorPresentationParams]
ReadPrec ColorPresentationParams
Int -> ReadS ColorPresentationParams
ReadS [ColorPresentationParams]
(Int -> ReadS ColorPresentationParams)
-> ReadS [ColorPresentationParams]
-> ReadPrec ColorPresentationParams
-> ReadPrec [ColorPresentationParams]
-> Read ColorPresentationParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorPresentationParams]
$creadListPrec :: ReadPrec [ColorPresentationParams]
readPrec :: ReadPrec ColorPresentationParams
$creadPrec :: ReadPrec ColorPresentationParams
readList :: ReadS [ColorPresentationParams]
$creadList :: ReadS [ColorPresentationParams]
readsPrec :: Int -> ReadS ColorPresentationParams
$creadsPrec :: Int -> ReadS ColorPresentationParams
Read, Int -> ColorPresentationParams -> ShowS
[ColorPresentationParams] -> ShowS
ColorPresentationParams -> String
(Int -> ColorPresentationParams -> ShowS)
-> (ColorPresentationParams -> String)
-> ([ColorPresentationParams] -> ShowS)
-> Show ColorPresentationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorPresentationParams] -> ShowS
$cshowList :: [ColorPresentationParams] -> ShowS
show :: ColorPresentationParams -> String
$cshow :: ColorPresentationParams -> String
showsPrec :: Int -> ColorPresentationParams -> ShowS
$cshowsPrec :: Int -> ColorPresentationParams -> ShowS
Show, ColorPresentationParams -> ColorPresentationParams -> Bool
(ColorPresentationParams -> ColorPresentationParams -> Bool)
-> (ColorPresentationParams -> ColorPresentationParams -> Bool)
-> Eq ColorPresentationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorPresentationParams -> ColorPresentationParams -> Bool
$c/= :: ColorPresentationParams -> ColorPresentationParams -> Bool
== :: ColorPresentationParams -> ColorPresentationParams -> Bool
$c== :: ColorPresentationParams -> ColorPresentationParams -> Bool
Eq)

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

type ColorPresentationRequest = 
  RequestMessage ClientMethod ColorPresentationParams (List ColorPresentation)
type ColorPresentationResponse = ResponseMessage (List ColorPresentation)