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

import           Control.Applicative
import           Data.Aeson
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.MarkupContent
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.TextDocument

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

{-
/**
 * MarkedString can be used to render human readable text. It is either a markdown string
 * or a code-block that provides a language and a code snippet. The language identifier
 * is semantically equal to the optional language identifier in fenced code blocks in GitHub
 * issues. See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting
 *
 * The pair of a language and a value is an equivalent to markdown:
 * ```${language}
 * ${value}
 * ```
 *
 * Note that markdown strings will be sanitized - that means html will be escaped.
* @deprecated use MarkupContent instead.
*/
type MarkedString = string | { language: string; value: string };

    error: code and message set in case an exception happens during the hover
    request.

Registration Options: TextDocumentRegistrationOptions

-}

data LanguageString =
  LanguageString
    { LanguageString -> Text
_language :: Text
    , LanguageString -> Text
_value    :: Text
    } deriving (ReadPrec [LanguageString]
ReadPrec LanguageString
Int -> ReadS LanguageString
ReadS [LanguageString]
(Int -> ReadS LanguageString)
-> ReadS [LanguageString]
-> ReadPrec LanguageString
-> ReadPrec [LanguageString]
-> Read LanguageString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LanguageString]
$creadListPrec :: ReadPrec [LanguageString]
readPrec :: ReadPrec LanguageString
$creadPrec :: ReadPrec LanguageString
readList :: ReadS [LanguageString]
$creadList :: ReadS [LanguageString]
readsPrec :: Int -> ReadS LanguageString
$creadsPrec :: Int -> ReadS LanguageString
Read,Int -> LanguageString -> ShowS
[LanguageString] -> ShowS
LanguageString -> String
(Int -> LanguageString -> ShowS)
-> (LanguageString -> String)
-> ([LanguageString] -> ShowS)
-> Show LanguageString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LanguageString] -> ShowS
$cshowList :: [LanguageString] -> ShowS
show :: LanguageString -> String
$cshow :: LanguageString -> String
showsPrec :: Int -> LanguageString -> ShowS
$cshowsPrec :: Int -> LanguageString -> ShowS
Show,LanguageString -> LanguageString -> Bool
(LanguageString -> LanguageString -> Bool)
-> (LanguageString -> LanguageString -> Bool) -> Eq LanguageString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LanguageString -> LanguageString -> Bool
$c/= :: LanguageString -> LanguageString -> Bool
== :: LanguageString -> LanguageString -> Bool
$c== :: LanguageString -> LanguageString -> Bool
Eq)

deriveJSON lspOptions ''LanguageString

{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}
data MarkedString =
    PlainString Text
  | CodeString LanguageString
    deriving (MarkedString -> MarkedString -> Bool
(MarkedString -> MarkedString -> Bool)
-> (MarkedString -> MarkedString -> Bool) -> Eq MarkedString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkedString -> MarkedString -> Bool
$c/= :: MarkedString -> MarkedString -> Bool
== :: MarkedString -> MarkedString -> Bool
$c== :: MarkedString -> MarkedString -> Bool
Eq,ReadPrec [MarkedString]
ReadPrec MarkedString
Int -> ReadS MarkedString
ReadS [MarkedString]
(Int -> ReadS MarkedString)
-> ReadS [MarkedString]
-> ReadPrec MarkedString
-> ReadPrec [MarkedString]
-> Read MarkedString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MarkedString]
$creadListPrec :: ReadPrec [MarkedString]
readPrec :: ReadPrec MarkedString
$creadPrec :: ReadPrec MarkedString
readList :: ReadS [MarkedString]
$creadList :: ReadS [MarkedString]
readsPrec :: Int -> ReadS MarkedString
$creadsPrec :: Int -> ReadS MarkedString
Read,Int -> MarkedString -> ShowS
[MarkedString] -> ShowS
MarkedString -> String
(Int -> MarkedString -> ShowS)
-> (MarkedString -> String)
-> ([MarkedString] -> ShowS)
-> Show MarkedString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkedString] -> ShowS
$cshowList :: [MarkedString] -> ShowS
show :: MarkedString -> String
$cshow :: MarkedString -> String
showsPrec :: Int -> MarkedString -> ShowS
$cshowsPrec :: Int -> MarkedString -> ShowS
Show)

instance ToJSON MarkedString where
  toJSON :: MarkedString -> Value
toJSON (PlainString Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
x
  toJSON (CodeString  LanguageString
x) = LanguageString -> Value
forall a. ToJSON a => a -> Value
toJSON LanguageString
x
instance FromJSON MarkedString where
  parseJSON :: Value -> Parser MarkedString
parseJSON (String Text
t) = MarkedString -> Parser MarkedString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkedString -> Parser MarkedString)
-> MarkedString -> Parser MarkedString
forall a b. (a -> b) -> a -> b
$ Text -> MarkedString
PlainString Text
t
  parseJSON Value
o            = LanguageString -> MarkedString
CodeString (LanguageString -> MarkedString)
-> Parser LanguageString -> Parser MarkedString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser LanguageString
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o

-- ---------------------------------------------------------------------
{-
Hover Request

The hover request is sent from the client to the server to request hover
information at a given text document position.

    Changed: In 2.0 the request uses TextDocumentPositionParams with a proper
    textDocument and position property. In 1.0 the uri of the referenced text
    document was inlined into the params object.

Request

    method: 'textDocument/hover'
    params: TextDocumentPositionParams

Response

    result: Hover | null defined as follows:


/**
 * The result of a hover request.
 */
interface Hover {
        /**
         * The hover's content
         */
        contents: MarkedString | MarkedString[] | MarkupContent;

        /**
         * An optional range is a range inside a text document
         * that is used to visualize a hover, e.g. by changing the background color.
         */
        range?: Range;
}

-}


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

data HoverContents =
    HoverContentsMS (List MarkedString)
  | HoverContents   MarkupContent
  deriving (ReadPrec [HoverContents]
ReadPrec HoverContents
Int -> ReadS HoverContents
ReadS [HoverContents]
(Int -> ReadS HoverContents)
-> ReadS [HoverContents]
-> ReadPrec HoverContents
-> ReadPrec [HoverContents]
-> Read HoverContents
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HoverContents]
$creadListPrec :: ReadPrec [HoverContents]
readPrec :: ReadPrec HoverContents
$creadPrec :: ReadPrec HoverContents
readList :: ReadS [HoverContents]
$creadList :: ReadS [HoverContents]
readsPrec :: Int -> ReadS HoverContents
$creadsPrec :: Int -> ReadS HoverContents
Read,Int -> HoverContents -> ShowS
[HoverContents] -> ShowS
HoverContents -> String
(Int -> HoverContents -> ShowS)
-> (HoverContents -> String)
-> ([HoverContents] -> ShowS)
-> Show HoverContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoverContents] -> ShowS
$cshowList :: [HoverContents] -> ShowS
show :: HoverContents -> String
$cshow :: HoverContents -> String
showsPrec :: Int -> HoverContents -> ShowS
$cshowsPrec :: Int -> HoverContents -> ShowS
Show,HoverContents -> HoverContents -> Bool
(HoverContents -> HoverContents -> Bool)
-> (HoverContents -> HoverContents -> Bool) -> Eq HoverContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoverContents -> HoverContents -> Bool
$c/= :: HoverContents -> HoverContents -> Bool
== :: HoverContents -> HoverContents -> Bool
$c== :: HoverContents -> HoverContents -> Bool
Eq)

instance ToJSON HoverContents where
  toJSON :: HoverContents -> Value
toJSON (HoverContentsMS  List MarkedString
x) = List MarkedString -> Value
forall a. ToJSON a => a -> Value
toJSON List MarkedString
x
  toJSON (HoverContents    MarkupContent
x) = MarkupContent -> Value
forall a. ToJSON a => a -> Value
toJSON MarkupContent
x
instance FromJSON HoverContents where
  parseJSON :: Value -> Parser HoverContents
parseJSON v :: Value
v@(String Text
_) = List MarkedString -> HoverContents
HoverContentsMS (List MarkedString -> HoverContents)
-> Parser (List MarkedString) -> Parser HoverContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (List MarkedString)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON v :: Value
v@(Array Array
_)  = List MarkedString -> HoverContents
HoverContentsMS (List MarkedString -> HoverContents)
-> Parser (List MarkedString) -> Parser HoverContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (List MarkedString)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON v :: Value
v@(Object Object
_) = MarkupContent -> HoverContents
HoverContents   (MarkupContent -> HoverContents)
-> Parser MarkupContent -> Parser HoverContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MarkupContent
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
                         Parser HoverContents
-> Parser HoverContents -> Parser HoverContents
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> List MarkedString -> HoverContents
HoverContentsMS (List MarkedString -> HoverContents)
-> Parser (List MarkedString) -> Parser HoverContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (List MarkedString)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
_ = Parser HoverContents
forall a. Monoid a => a
mempty

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

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup HoverContents where
  <> :: HoverContents -> HoverContents -> HoverContents
(<>) = HoverContents -> HoverContents -> HoverContents
forall a. Monoid a => a -> a -> a
mappend
#endif

instance Monoid HoverContents where
  mempty :: HoverContents
mempty = List MarkedString -> HoverContents
HoverContentsMS ([MarkedString] -> List MarkedString
forall a. [a] -> List a
List [])

  HoverContents MarkupContent
h1   mappend :: HoverContents -> HoverContents -> HoverContents
`mappend` HoverContents         MarkupContent
h2   = MarkupContent -> HoverContents
HoverContents (MarkupContent
h1 MarkupContent -> MarkupContent -> MarkupContent
forall a. Monoid a => a -> a -> a
`mappend` MarkupContent
h2)
  HoverContents MarkupContent
h1   `mappend` HoverContentsMS (List [MarkedString]
h2s) = MarkupContent -> HoverContents
HoverContents ([MarkupContent] -> MarkupContent
forall a. Monoid a => [a] -> a
mconcat (MarkupContent
h1MarkupContent -> [MarkupContent] -> [MarkupContent]
forall a. a -> [a] -> [a]
: ((MarkedString -> MarkupContent)
-> [MarkedString] -> [MarkupContent]
forall a b. (a -> b) -> [a] -> [b]
map MarkedString -> MarkupContent
toMarkupContent [MarkedString]
h2s)))
  HoverContentsMS (List [MarkedString]
h1s) `mappend` HoverContents         MarkupContent
h2    = MarkupContent -> HoverContents
HoverContents ([MarkupContent] -> MarkupContent
forall a. Monoid a => [a] -> a
mconcat (((MarkedString -> MarkupContent)
-> [MarkedString] -> [MarkupContent]
forall a b. (a -> b) -> [a] -> [b]
map MarkedString -> MarkupContent
toMarkupContent [MarkedString]
h1s) [MarkupContent] -> [MarkupContent] -> [MarkupContent]
forall a. [a] -> [a] -> [a]
++ [MarkupContent
h2]))
  HoverContentsMS (List [MarkedString]
h1s) `mappend` HoverContentsMS (List [MarkedString]
h2s) = List MarkedString -> HoverContents
HoverContentsMS ([MarkedString] -> List MarkedString
forall a. [a] -> List a
List ([MarkedString]
h1s [MarkedString] -> [MarkedString] -> [MarkedString]
forall a. Monoid a => a -> a -> a
`mappend` [MarkedString]
h2s))

toMarkupContent :: MarkedString -> MarkupContent
toMarkupContent :: MarkedString -> MarkupContent
toMarkupContent (PlainString Text
s) = Text -> MarkupContent
unmarkedUpContent Text
s
toMarkupContent (CodeString (LanguageString Text
lang Text
s)) = Text -> Text -> MarkupContent
markedUpContent Text
lang Text
s

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

data Hover =
  Hover
    { Hover -> HoverContents
_contents :: HoverContents
    , Hover -> Maybe Range
_range    :: Maybe Range
    } deriving (ReadPrec [Hover]
ReadPrec Hover
Int -> ReadS Hover
ReadS [Hover]
(Int -> ReadS Hover)
-> ReadS [Hover]
-> ReadPrec Hover
-> ReadPrec [Hover]
-> Read Hover
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Hover]
$creadListPrec :: ReadPrec [Hover]
readPrec :: ReadPrec Hover
$creadPrec :: ReadPrec Hover
readList :: ReadS [Hover]
$creadList :: ReadS [Hover]
readsPrec :: Int -> ReadS Hover
$creadsPrec :: Int -> ReadS Hover
Read,Int -> Hover -> ShowS
[Hover] -> ShowS
Hover -> String
(Int -> Hover -> ShowS)
-> (Hover -> String) -> ([Hover] -> ShowS) -> Show Hover
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hover] -> ShowS
$cshowList :: [Hover] -> ShowS
show :: Hover -> String
$cshow :: Hover -> String
showsPrec :: Int -> Hover -> ShowS
$cshowsPrec :: Int -> Hover -> ShowS
Show,Hover -> Hover -> Bool
(Hover -> Hover -> Bool) -> (Hover -> Hover -> Bool) -> Eq Hover
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hover -> Hover -> Bool
$c/= :: Hover -> Hover -> Bool
== :: Hover -> Hover -> Bool
$c== :: Hover -> Hover -> Bool
Eq)

deriveJSON lspOptions ''Hover

type HoverRequest = RequestMessage ClientMethod TextDocumentPositionParams (Maybe Hover)
type HoverResponse = ResponseMessage (Maybe Hover)