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

import           Control.Applicative
import           Data.Aeson
import           Data.Aeson.TH
import           Data.Text                      ( Text )

import           Language.LSP.Types.Common
import           Language.LSP.Types.Location
import           Language.LSP.Types.MarkupContent
import           Language.LSP.Types.Progress
import           Language.LSP.Types.TextDocument
import           Language.LSP.Types.Utils


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

data HoverClientCapabilities =
  HoverClientCapabilities
    { HoverClientCapabilities -> Maybe Bool
_dynamicRegistration :: Maybe Bool
    , HoverClientCapabilities -> Maybe (List MarkupKind)
_contentFormat :: Maybe (List MarkupKind)
    } deriving (Int -> HoverClientCapabilities -> ShowS
[HoverClientCapabilities] -> ShowS
HoverClientCapabilities -> String
(Int -> HoverClientCapabilities -> ShowS)
-> (HoverClientCapabilities -> String)
-> ([HoverClientCapabilities] -> ShowS)
-> Show HoverClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoverClientCapabilities] -> ShowS
$cshowList :: [HoverClientCapabilities] -> ShowS
show :: HoverClientCapabilities -> String
$cshow :: HoverClientCapabilities -> String
showsPrec :: Int -> HoverClientCapabilities -> ShowS
$cshowsPrec :: Int -> HoverClientCapabilities -> ShowS
Show, ReadPrec [HoverClientCapabilities]
ReadPrec HoverClientCapabilities
Int -> ReadS HoverClientCapabilities
ReadS [HoverClientCapabilities]
(Int -> ReadS HoverClientCapabilities)
-> ReadS [HoverClientCapabilities]
-> ReadPrec HoverClientCapabilities
-> ReadPrec [HoverClientCapabilities]
-> Read HoverClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HoverClientCapabilities]
$creadListPrec :: ReadPrec [HoverClientCapabilities]
readPrec :: ReadPrec HoverClientCapabilities
$creadPrec :: ReadPrec HoverClientCapabilities
readList :: ReadS [HoverClientCapabilities]
$creadList :: ReadS [HoverClientCapabilities]
readsPrec :: Int -> ReadS HoverClientCapabilities
$creadsPrec :: Int -> ReadS HoverClientCapabilities
Read, HoverClientCapabilities -> HoverClientCapabilities -> Bool
(HoverClientCapabilities -> HoverClientCapabilities -> Bool)
-> (HoverClientCapabilities -> HoverClientCapabilities -> Bool)
-> Eq HoverClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoverClientCapabilities -> HoverClientCapabilities -> Bool
$c/= :: HoverClientCapabilities -> HoverClientCapabilities -> Bool
== :: HoverClientCapabilities -> HoverClientCapabilities -> Bool
$c== :: HoverClientCapabilities -> HoverClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''HoverClientCapabilities

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

makeExtendingDatatype "HoverRegistrationOptions" [''TextDocumentRegistrationOptions, ''HoverOptions] []
deriveJSON lspOptions ''HoverRegistrationOptions

makeExtendingDatatype "HoverParams" [''TextDocumentPositionParams, ''WorkDoneProgressParams] []
deriveJSON lspOptions ''HoverParams

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

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

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

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

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

instance Semigroup HoverContents where
  HoverContents MarkupContent
h1   <> :: HoverContents -> HoverContents -> HoverContents
<> HoverContents         MarkupContent
h2   = MarkupContent -> HoverContents
HoverContents (MarkupContent
h1 MarkupContent -> MarkupContent -> MarkupContent
forall a. Monoid a => a -> a -> a
`mappend` MarkupContent
h2)
  HoverContents MarkupContent
h1   <> 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) <> 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) <> 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))

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

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