{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
module Language.LSP.Protocol.Types.Common (
type (|?) (..),
toEither,
_L,
_R,
Int32,
UInt,
Null (..),
absorbNull,
nullToMaybe,
maybeToNull,
(.=?),
) where
import Control.DeepSeq
import Control.Lens
import Data.Aeson hiding (Null)
import Data.Aeson qualified as J
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif
import Data.Hashable
import Data.Int (Int32)
import Data.Mod.Word
import Data.Set as Set
import Data.String (fromString)
import GHC.Generics hiding (UInt)
import GHC.TypeNats hiding (Mod)
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import Text.Read (Read (readPrec))
newtype UInt = UInt (Mod (2 ^ 31))
deriving newtype (Integer -> UInt
UInt -> UInt
UInt -> UInt -> UInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> UInt
$cfromInteger :: Integer -> UInt
signum :: UInt -> UInt
$csignum :: UInt -> UInt
abs :: UInt -> UInt
$cabs :: UInt -> UInt
negate :: UInt -> UInt
$cnegate :: UInt -> UInt
* :: UInt -> UInt -> UInt
$c* :: UInt -> UInt -> UInt
- :: UInt -> UInt -> UInt
$c- :: UInt -> UInt -> UInt
+ :: UInt -> UInt -> UInt
$c+ :: UInt -> UInt -> UInt
Num, UInt
forall a. a -> a -> Bounded a
maxBound :: UInt
$cmaxBound :: UInt
minBound :: UInt
$cminBound :: UInt
Bounded, Int -> UInt
UInt -> Int
UInt -> [UInt]
UInt -> UInt
UInt -> UInt -> [UInt]
UInt -> UInt -> UInt -> [UInt]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UInt -> UInt -> UInt -> [UInt]
$cenumFromThenTo :: UInt -> UInt -> UInt -> [UInt]
enumFromTo :: UInt -> UInt -> [UInt]
$cenumFromTo :: UInt -> UInt -> [UInt]
enumFromThen :: UInt -> UInt -> [UInt]
$cenumFromThen :: UInt -> UInt -> [UInt]
enumFrom :: UInt -> [UInt]
$cenumFrom :: UInt -> [UInt]
fromEnum :: UInt -> Int
$cfromEnum :: UInt -> Int
toEnum :: Int -> UInt
$ctoEnum :: Int -> UInt
pred :: UInt -> UInt
$cpred :: UInt -> UInt
succ :: UInt -> UInt
$csucc :: UInt -> UInt
Enum, UInt -> UInt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UInt -> UInt -> Bool
$c/= :: UInt -> UInt -> Bool
== :: UInt -> UInt -> Bool
$c== :: UInt -> UInt -> Bool
Eq, Eq UInt
UInt -> UInt -> Bool
UInt -> UInt -> Ordering
UInt -> UInt -> UInt
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
min :: UInt -> UInt -> UInt
$cmin :: UInt -> UInt -> UInt
max :: UInt -> UInt -> UInt
$cmax :: UInt -> UInt -> UInt
>= :: UInt -> UInt -> Bool
$c>= :: UInt -> UInt -> Bool
> :: UInt -> UInt -> Bool
$c> :: UInt -> UInt -> Bool
<= :: UInt -> UInt -> Bool
$c<= :: UInt -> UInt -> Bool
< :: UInt -> UInt -> Bool
$c< :: UInt -> UInt -> Bool
compare :: UInt -> UInt -> Ordering
$ccompare :: UInt -> UInt -> Ordering
Ord)
deriving stock (forall x. Rep UInt x -> UInt
forall x. UInt -> Rep UInt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UInt x -> UInt
$cfrom :: forall x. UInt -> Rep UInt x
Generic)
deriving anyclass (UInt -> ()
forall a. (a -> ()) -> NFData a
rnf :: UInt -> ()
$crnf :: UInt -> ()
NFData)
instance Hashable UInt where hashWithSalt :: Int -> UInt -> Int
hashWithSalt Int
s (UInt Mod (2 ^ 31)
n) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
n)
instance Show UInt where
show :: UInt -> String
show (UInt Mod (2 ^ 31)
u) = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
u
instance Read UInt where
readPrec :: ReadPrec UInt
readPrec = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
instance Pretty UInt where
pretty :: forall ann. UInt -> Doc ann
pretty = forall a ann. Show a => a -> Doc ann
viaShow
instance Real UInt where
toRational :: UInt -> Rational
toRational (UInt Mod (2 ^ 31)
u) = forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
u
instance Integral UInt where
quotRem :: UInt -> UInt -> (UInt, UInt)
quotRem (UInt Mod (2 ^ 31)
x) (UInt Mod (2 ^ 31)
y) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> (a, a)
quotRem (forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
x) (forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
y)
toInteger :: UInt -> Integer
toInteger (UInt Mod (2 ^ 31)
u) = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall (m :: Nat). Mod m -> Word
unMod Mod (2 ^ 31)
u
instance ToJSON UInt where
toJSON :: UInt -> Value
toJSON UInt
u = forall a. ToJSON a => a -> Value
toJSON (forall a. Integral a => a -> Integer
toInteger UInt
u)
instance FromJSON UInt where
parseJSON :: Value -> Parser UInt
parseJSON Value
v = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
data a |? b
= InL a
| InR b
deriving stock (ReadPrec [a |? b]
ReadPrec (a |? b)
ReadS [a |? b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [a |? b]
forall a b. (Read a, Read b) => ReadPrec (a |? b)
forall a b. (Read a, Read b) => Int -> ReadS (a |? b)
forall a b. (Read a, Read b) => ReadS [a |? b]
readListPrec :: ReadPrec [a |? b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [a |? b]
readPrec :: ReadPrec (a |? b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (a |? b)
readList :: ReadS [a |? b]
$creadList :: forall a b. (Read a, Read b) => ReadS [a |? b]
readsPrec :: Int -> ReadS (a |? b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (a |? b)
Read, Int -> (a |? b) -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a |? b) -> ShowS
forall a b. (Show a, Show b) => [a |? b] -> ShowS
forall a b. (Show a, Show b) => (a |? b) -> String
showList :: [a |? b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a |? b] -> ShowS
show :: (a |? b) -> String
$cshow :: forall a b. (Show a, Show b) => (a |? b) -> String
showsPrec :: Int -> (a |? b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a |? b) -> ShowS
Show, (a |? b) -> (a |? b) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a |? b) -> (a |? b) -> Bool
/= :: (a |? b) -> (a |? b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a |? b) -> (a |? b) -> Bool
== :: (a |? b) -> (a |? b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a |? b) -> (a |? b) -> Bool
Eq, (a |? b) -> (a |? b) -> Bool
(a |? b) -> (a |? b) -> Ordering
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 {a} {b}. (Ord a, Ord b) => Eq (a |? b)
forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Bool
forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Ordering
forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> a |? b
min :: (a |? b) -> (a |? b) -> a |? b
$cmin :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> a |? b
max :: (a |? b) -> (a |? b) -> a |? b
$cmax :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> a |? b
>= :: (a |? b) -> (a |? b) -> Bool
$c>= :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Bool
> :: (a |? b) -> (a |? b) -> Bool
$c> :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Bool
<= :: (a |? b) -> (a |? b) -> Bool
$c<= :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Bool
< :: (a |? b) -> (a |? b) -> Bool
$c< :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Bool
compare :: (a |? b) -> (a |? b) -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (a |? b) x -> a |? b
forall a b x. (a |? b) -> Rep (a |? b) x
$cto :: forall a b x. Rep (a |? b) x -> a |? b
$cfrom :: forall a b x. (a |? b) -> Rep (a |? b) x
Generic)
deriving anyclass (forall a. (a -> ()) -> NFData a
forall a b. (NFData a, NFData b) => (a |? b) -> ()
rnf :: (a |? b) -> ()
$crnf :: forall a b. (NFData a, NFData b) => (a |? b) -> ()
NFData, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a} {b}. (Hashable a, Hashable b) => Eq (a |? b)
forall a b. (Hashable a, Hashable b) => Int -> (a |? b) -> Int
forall a b. (Hashable a, Hashable b) => (a |? b) -> Int
hash :: (a |? b) -> Int
$chash :: forall a b. (Hashable a, Hashable b) => (a |? b) -> Int
hashWithSalt :: Int -> (a |? b) -> Int
$chashWithSalt :: forall a b. (Hashable a, Hashable b) => Int -> (a |? b) -> Int
Hashable)
deriving (forall ann. [a |? b] -> Doc ann
forall ann. (a |? b) -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
forall a b ann. (ToJSON a, ToJSON b) => [a |? b] -> Doc ann
forall a b ann. (ToJSON a, ToJSON b) => (a |? b) -> Doc ann
prettyList :: forall ann. [a |? b] -> Doc ann
$cprettyList :: forall a b ann. (ToJSON a, ToJSON b) => [a |? b] -> Doc ann
pretty :: forall ann. (a |? b) -> Doc ann
$cpretty :: forall a b ann. (ToJSON a, ToJSON b) => (a |? b) -> Doc ann
Pretty) via (ViaJSON (a |? b))
infixr 9 |?
_L :: Prism' (a |? b) a
_L :: forall a b. Prism' (a |? b) a
_L = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ \case
InL a
a -> forall a. a -> Maybe a
Just a
a
InR b
_ -> forall a. Maybe a
Nothing
_R :: Prism' (a |? b) b
_R :: forall a b. Prism' (a |? b) b
_R = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ \case
InL a
_ -> forall a. Maybe a
Nothing
InR b
b -> forall a. a -> Maybe a
Just b
b
toEither :: a |? b -> Either a b
toEither :: forall a b. (a |? b) -> Either a b
toEither (InL a
a) = forall a b. a -> Either a b
Left a
a
toEither (InR b
b) = forall a b. b -> Either a b
Right b
b
instance (ToJSON a, ToJSON b) => ToJSON (a |? b) where
toJSON :: (a |? b) -> Value
toJSON (InL a
x) = forall a. ToJSON a => a -> Value
toJSON a
x
toJSON (InR b
x) = forall a. ToJSON a => a -> Value
toJSON b
x
instance (FromJSON a, ToJSON a, FromJSON b, ToJSON b) => FromJSON (a |? b) where
parseJSON :: Value -> Parser (a |? b)
parseJSON Value
v = do
let Result a
ra :: Result a = forall a. FromJSON a => Value -> Result a
fromJSON Value
v
Result b
rb :: Result b = forall a. FromJSON a => Value -> Result a
fromJSON Value
v
case (Result a
ra, Result b
rb) of
(Success a
a, Error String
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL a
a
(Error String
_, Success b
b) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR b
b
(Error String
e, Error String
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
(Success a
a, Success b
b) -> case (forall a. ToJSON a => a -> Value
toJSON a
a, forall a. ToJSON a => a -> Value
toJSON b
b) of
(Value
l, Value
r) | Value
l forall a. Eq a => a -> a -> Bool
== Value
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL a
a
(Object Object
oa, Object Object
ob) ->
let ka :: Set Key
ka = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [Key]
KM.keys Object
oa
kb :: Set Key
kb = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [Key]
KM.keys Object
ob
in if Set Key
kb forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Key
ka
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL a
a
else
if Set Key
ka forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Key
kb
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR b
b
else forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not decide which type of value to produce, left encodes to an object with keys: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Set Key
ka forall a. [a] -> [a] -> [a]
++ String
"; right has keys " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Set Key
kb
(Value
l, Value
r) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not decide which type of value to produce, left encodes to: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
l forall a. [a] -> [a] -> [a]
++ String
"; right encodes to: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
r
data Null = Null
deriving stock (Null -> Null -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Null -> Null -> Bool
$c/= :: Null -> Null -> Bool
== :: Null -> Null -> Bool
$c== :: Null -> Null -> Bool
Eq, Eq Null
Null -> Null -> Bool
Null -> Null -> Ordering
Null -> Null -> Null
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
min :: Null -> Null -> Null
$cmin :: Null -> Null -> Null
max :: Null -> Null -> Null
$cmax :: Null -> Null -> Null
>= :: Null -> Null -> Bool
$c>= :: Null -> Null -> Bool
> :: Null -> Null -> Bool
$c> :: Null -> Null -> Bool
<= :: Null -> Null -> Bool
$c<= :: Null -> Null -> Bool
< :: Null -> Null -> Bool
$c< :: Null -> Null -> Bool
compare :: Null -> Null -> Ordering
$ccompare :: Null -> Null -> Ordering
Ord, Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Null] -> ShowS
$cshowList :: [Null] -> ShowS
show :: Null -> String
$cshow :: Null -> String
showsPrec :: Int -> Null -> ShowS
$cshowsPrec :: Int -> Null -> ShowS
Show, forall x. Rep Null x -> Null
forall x. Null -> Rep Null x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Null x -> Null
$cfrom :: forall x. Null -> Rep Null x
Generic)
deriving anyclass (Null -> ()
forall a. (a -> ()) -> NFData a
rnf :: Null -> ()
$crnf :: Null -> ()
NFData, Eq Null
Int -> Null -> Int
Null -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Null -> Int
$chash :: Null -> Int
hashWithSalt :: Int -> Null -> Int
$chashWithSalt :: Int -> Null -> Int
Hashable)
deriving (forall ann. [Null] -> Doc ann
forall ann. Null -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [Null] -> Doc ann
$cprettyList :: forall ann. [Null] -> Doc ann
pretty :: forall ann. Null -> Doc ann
$cpretty :: forall ann. Null -> Doc ann
Pretty) via (ViaJSON Null)
instance ToJSON Null where
toJSON :: Null -> Value
toJSON Null
Null = Value
J.Null
instance FromJSON Null where
parseJSON :: Value -> Parser Null
parseJSON Value
J.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
Null
parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected 'null'"
absorbNull :: Monoid a => a |? Null -> a
absorbNull :: forall a. Monoid a => (a |? Null) -> a
absorbNull (InL a
a) = a
a
absorbNull (InR Null
_) = forall a. Monoid a => a
mempty
nullToMaybe :: a |? Null -> Maybe a
nullToMaybe :: forall a. (a |? Null) -> Maybe a
nullToMaybe (InL a
a) = forall a. a -> Maybe a
Just a
a
nullToMaybe (InR Null
_) = forall a. Maybe a
Nothing
maybeToNull :: Maybe a -> a |? Null
maybeToNull :: forall a. Maybe a -> a |? Null
maybeToNull (Just a
x) = forall a b. a -> a |? b
InL a
x
maybeToNull Maybe a
Nothing = forall a b. b -> a |? b
InR Null
Null
instance Semigroup s => Semigroup (s |? Null) where
InL s
x <> :: (s |? Null) -> (s |? Null) -> s |? Null
<> InL s
y = forall a b. a -> a |? b
InL (s
x forall a. Semigroup a => a -> a -> a
<> s
y)
InL s
x <> InR Null
_ = forall a b. a -> a |? b
InL s
x
InR Null
_ <> InL s
x = forall a b. a -> a |? b
InL s
x
InR Null
_ <> InR Null
y = forall a b. b -> a |? b
InR Null
y
#if MIN_VERSION_aeson(2,2,0)
(.=?) :: (J.KeyValue e kv, J.ToJSON v) => String -> Maybe v -> [kv]
#else
(.=?) :: (J.KeyValue kv, J.ToJSON v) => String -> Maybe v -> [kv]
#endif
String
k .=? :: forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
.=? Maybe v
v = case Maybe v
v of
Just v
v' -> [forall a. IsString a => String -> a
fromString String
k forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= v
v']
Maybe v
Nothing -> forall a. Monoid a => a
mempty