{-# LANGUAGE TypeInType #-}

module Language.LSP.Protocol.Message.LspId where

import Data.Aeson qualified as A
import Data.Hashable
import Data.IxMap
import Data.Text (Text)
import GHC.Generics
import Prettyprinter

import Language.LSP.Protocol.Internal.Method
import Language.LSP.Protocol.Message.Meta
import Language.LSP.Protocol.Types.Common
import Language.LSP.Protocol.Utils.Misc

-- | Id used for a request, Can be either a String or an Int
data LspId (m :: Method f Request) = IdInt !Int32 | IdString !Text
  deriving stock (Int -> LspId m -> ShowS
[LspId m] -> ShowS
LspId m -> String
(Int -> LspId m -> ShowS)
-> (LspId m -> String) -> ([LspId m] -> ShowS) -> Show (LspId m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: MessageDirection) (m :: Method f 'Request).
Int -> LspId m -> ShowS
forall (f :: MessageDirection) (m :: Method f 'Request).
[LspId m] -> ShowS
forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> String
$cshowsPrec :: forall (f :: MessageDirection) (m :: Method f 'Request).
Int -> LspId m -> ShowS
showsPrec :: Int -> LspId m -> ShowS
$cshow :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> String
show :: LspId m -> String
$cshowList :: forall (f :: MessageDirection) (m :: Method f 'Request).
[LspId m] -> ShowS
showList :: [LspId m] -> ShowS
Show, ReadPrec [LspId m]
ReadPrec (LspId m)
Int -> ReadS (LspId m)
ReadS [LspId m]
(Int -> ReadS (LspId m))
-> ReadS [LspId m]
-> ReadPrec (LspId m)
-> ReadPrec [LspId m]
-> Read (LspId m)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: MessageDirection) (m :: Method f 'Request).
ReadPrec [LspId m]
forall (f :: MessageDirection) (m :: Method f 'Request).
ReadPrec (LspId m)
forall (f :: MessageDirection) (m :: Method f 'Request).
Int -> ReadS (LspId m)
forall (f :: MessageDirection) (m :: Method f 'Request).
ReadS [LspId m]
$creadsPrec :: forall (f :: MessageDirection) (m :: Method f 'Request).
Int -> ReadS (LspId m)
readsPrec :: Int -> ReadS (LspId m)
$creadList :: forall (f :: MessageDirection) (m :: Method f 'Request).
ReadS [LspId m]
readList :: ReadS [LspId m]
$creadPrec :: forall (f :: MessageDirection) (m :: Method f 'Request).
ReadPrec (LspId m)
readPrec :: ReadPrec (LspId m)
$creadListPrec :: forall (f :: MessageDirection) (m :: Method f 'Request).
ReadPrec [LspId m]
readListPrec :: ReadPrec [LspId m]
Read, LspId m -> LspId m -> Bool
(LspId m -> LspId m -> Bool)
-> (LspId m -> LspId m -> Bool) -> Eq (LspId m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
$c== :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
== :: LspId m -> LspId m -> Bool
$c/= :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
/= :: LspId m -> LspId m -> Bool
Eq, Eq (LspId m)
Eq (LspId m) =>
(LspId m -> LspId m -> Ordering)
-> (LspId m -> LspId m -> Bool)
-> (LspId m -> LspId m -> Bool)
-> (LspId m -> LspId m -> Bool)
-> (LspId m -> LspId m -> Bool)
-> (LspId m -> LspId m -> LspId m)
-> (LspId m -> LspId m -> LspId m)
-> Ord (LspId m)
LspId m -> LspId m -> Bool
LspId m -> LspId m -> Ordering
LspId m -> LspId m -> LspId m
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: MessageDirection) (m :: Method f 'Request).
Eq (LspId m)
forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Ordering
forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> LspId m
$ccompare :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Ordering
compare :: LspId m -> LspId m -> Ordering
$c< :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
< :: LspId m -> LspId m -> Bool
$c<= :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
<= :: LspId m -> LspId m -> Bool
$c> :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
> :: LspId m -> LspId m -> Bool
$c>= :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> Bool
>= :: LspId m -> LspId m -> Bool
$cmax :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> LspId m
max :: LspId m -> LspId m -> LspId m
$cmin :: forall (f :: MessageDirection) (m :: Method f 'Request).
LspId m -> LspId m -> LspId m
min :: LspId m -> LspId m -> LspId m
Ord, (forall x. LspId m -> Rep (LspId m) x)
-> (forall x. Rep (LspId m) x -> LspId m) -> Generic (LspId m)
forall x. Rep (LspId m) x -> LspId m
forall x. LspId m -> Rep (LspId m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (LspId m) x -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request) x.
LspId m -> Rep (LspId m) x
$cfrom :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
LspId m -> Rep (LspId m) x
from :: forall x. LspId m -> Rep (LspId m) x
$cto :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (LspId m) x -> LspId m
to :: forall x. Rep (LspId m) x -> LspId m
Generic)

instance A.ToJSON (LspId m) where
  toJSON :: LspId m -> Value
toJSON (IdInt Int32
i) = Int32 -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int32
i
  toJSON (IdString Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
s

instance A.FromJSON (LspId m) where
  parseJSON :: Value -> Parser (LspId m)
parseJSON v :: Value
v@(A.Number Scientific
_) = Int32 -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt (Int32 -> LspId m) -> Parser Int32 -> Parser (LspId m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int32
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v
  parseJSON (A.String Text
s) = LspId m -> Parser (LspId m)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Text -> LspId m
IdString Text
s)
  parseJSON Value
_ = String -> Parser (LspId m)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LspId"

deriving via ViaJSON (LspId m) instance Pretty (LspId m)

instance IxOrd LspId where
  type Base LspId = SomeLspId
  toBase :: forall (a :: Method f 'Request). LspId a -> Base LspId
toBase = LspId a -> Base LspId
LspId a -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId

instance Hashable (LspId m) where
  hashWithSalt :: Int -> LspId m -> Int
hashWithSalt Int
n (IdInt Int32
i) = Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n Int32
i
  hashWithSalt Int
n (IdString Text
t) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n Text
t

data SomeLspId where
  SomeLspId :: !(LspId m) -> SomeLspId

deriving stock instance Show SomeLspId
instance Eq SomeLspId where
  SomeLspId (IdInt Int32
a) == :: SomeLspId -> SomeLspId -> Bool
== SomeLspId (IdInt Int32
b) = Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
b
  SomeLspId (IdString Text
a) == SomeLspId (IdString Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
  SomeLspId
_ == SomeLspId
_ = Bool
False
instance Ord SomeLspId where
  compare :: SomeLspId -> SomeLspId -> Ordering
compare (SomeLspId LspId m
x) (SomeLspId LspId m
y) = LspId m -> LspId m -> Ordering
forall {f :: MessageDirection} {f :: MessageDirection}
       {m :: Method f 'Request} {m :: Method f 'Request}.
LspId m -> LspId m -> Ordering
go LspId m
x LspId m
y
   where
    go :: LspId m -> LspId m -> Ordering
go (IdInt Int32
a) (IdInt Int32
b) = Int32
a Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int32
b
    go (IdString Text
a) (IdString Text
b) = Text
a Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Text
b
    go (IdInt Int32
_) (IdString Text
_) = Ordering
LT
    go (IdString Text
_) (IdInt Int32
_) = Ordering
GT

instance Hashable SomeLspId where
  hashWithSalt :: Int -> SomeLspId -> Int
hashWithSalt Int
n (SomeLspId LspId m
lspId) = Int -> LspId m -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n LspId m
lspId