{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Language.LSP.Protocol.Message.Method where
import Data.Aeson.Types
import Data.Function (on)
import Data.GADT.Compare
import Data.List (isPrefixOf)
import Data.Proxy
import Data.Type.Equality
import GHC.Exts (Int (..), dataToTag#)
import GHC.TypeLits (
KnownSymbol,
sameSymbol,
symbolVal,
)
import Language.LSP.Protocol.Internal.Method
import Language.LSP.Protocol.Message.Meta
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import Unsafe.Coerce
isOptionalMethod :: SomeMethod -> Bool
isOptionalMethod :: SomeMethod -> Bool
isOptionalMethod SomeMethod
m = [Char]
"$/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` SomeMethod -> [Char]
someMethodToMethodString SomeMethod
m
deriving stock instance Show SomeMethod
instance Eq SomeMethod where
== :: SomeMethod -> SomeMethod -> Bool
(==) = [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool)
-> (SomeMethod -> [Char]) -> SomeMethod -> SomeMethod -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SomeMethod -> [Char]
someMethodToMethodString
instance Ord SomeMethod where
compare :: SomeMethod -> SomeMethod -> Ordering
compare = [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (SomeMethod -> [Char]) -> SomeMethod -> SomeMethod -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SomeMethod -> [Char]
someMethodToMethodString
instance ToJSON SomeMethod where
toJSON :: SomeMethod -> Value
toJSON SomeMethod
sm = [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ SomeMethod -> [Char]
someMethodToMethodString SomeMethod
sm
instance FromJSON SomeMethod where
parseJSON :: Value -> Parser SomeMethod
parseJSON Value
v = do
[Char]
s <- Value -> Parser [Char]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
SomeMethod -> Parser SomeMethod
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeMethod -> Parser SomeMethod)
-> SomeMethod -> Parser SomeMethod
forall a b. (a -> b) -> a -> b
$ [Char] -> SomeMethod
methodStringToSomeMethod [Char]
s
deriving via ViaJSON SomeMethod instance Pretty SomeMethod
instance GEq SMethod where
geq :: forall (a :: Method f t) (b :: Method f t).
SMethod a -> SMethod b -> Maybe (a :~: b)
geq SMethod a
x SMethod b
y = case SMethod a -> SMethod b -> GOrdering a b
forall k (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
forall (a :: Method f t) (b :: Method f t).
SMethod a -> SMethod b -> GOrdering a b
gcompare SMethod a
x SMethod b
y of
GOrdering a b
GLT -> Maybe (a :~: b)
forall a. Maybe a
Nothing
GOrdering a b
GEQ -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
GOrdering a b
GGT -> Maybe (a :~: b)
forall a. Maybe a
Nothing
instance GCompare SMethod where
gcompare :: forall (a :: Method f t) (b :: Method f t).
SMethod a -> SMethod b -> GOrdering a b
gcompare (SMethod_CustomMethod Proxy s
x) (SMethod_CustomMethod Proxy s
y) = case Proxy s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal Proxy s
x [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Proxy s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal Proxy s
y of
Ordering
LT -> GOrdering a b
forall {k} (a :: k) (b :: k). GOrdering a b
GLT
Ordering
EQ -> GOrdering Any Any -> GOrdering a b
forall a b. a -> b
unsafeCoerce GOrdering Any Any
forall {k} (a :: k). GOrdering a a
GEQ
Ordering
GT -> GOrdering a b
forall {k} (a :: k) (b :: k). GOrdering a b
GGT
gcompare SMethod a
x SMethod b
y = case Int# -> Int
I# (SMethod a -> Int#
forall a. a -> Int#
dataToTag# SMethod a
x) Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int# -> Int
I# (SMethod b -> Int#
forall a. a -> Int#
dataToTag# SMethod b
y) of
Ordering
LT -> GOrdering a b
forall {k} (a :: k) (b :: k). GOrdering a b
GLT
Ordering
EQ -> GOrdering Any Any -> GOrdering a b
forall a b. a -> b
unsafeCoerce GOrdering Any Any
forall {k} (a :: k). GOrdering a a
GEQ
Ordering
GT -> GOrdering a b
forall {k} (a :: k) (b :: k). GOrdering a b
GGT
instance Eq (SMethod m) where
== :: SMethod m -> SMethod m -> Bool
(==) = SMethod m -> SMethod m -> Bool
forall {k} (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Bool
defaultEq
instance Ord (SMethod m) where
compare :: SMethod m -> SMethod m -> Ordering
compare = SMethod m -> SMethod m -> Ordering
forall {k} (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> Ordering
defaultCompare
deriving stock instance Show (SMethod m)
instance ToJSON (SMethod m) where
toJSON :: SMethod m -> Value
toJSON SMethod m
m = SomeMethod -> Value
forall a. ToJSON a => a -> Value
toJSON (SMethod m -> SomeMethod
forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
SMethod m -> SomeMethod
SomeMethod SMethod m
m)
instance KnownSymbol s => FromJSON (SMethod ('Method_CustomMethod s :: Method f t)) where
parseJSON :: Value -> Parser (SMethod ('Method_CustomMethod s))
parseJSON Value
v = do
SomeMethod
sm <- Value -> Parser SomeMethod
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
case SomeMethod
sm of
SomeMethod (SMethod_CustomMethod Proxy s
x) -> case Proxy s -> Proxy s -> Maybe (s :~: s)
forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
(proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol Proxy s
x (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s) of
Just s :~: s
Refl -> SMethod ('Method_CustomMethod s)
-> Parser (SMethod ('Method_CustomMethod s))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMethod ('Method_CustomMethod s)
-> Parser (SMethod ('Method_CustomMethod s)))
-> SMethod ('Method_CustomMethod s)
-> Parser (SMethod ('Method_CustomMethod s))
forall a b. (a -> b) -> a -> b
$ Proxy s -> SMethod ('Method_CustomMethod s)
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
Proxy s
x
Maybe (s :~: s)
Nothing -> Parser (SMethod ('Method_CustomMethod s))
forall a. Monoid a => a
mempty
SomeMethod
_ -> Parser (SMethod ('Method_CustomMethod s))
forall a. Monoid a => a
mempty