{-# 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 qualified Data.Aeson 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.Set as Set
import Data.String (fromString)
import Data.Int (Int32)
import Data.Mod.Word
import GHC.Generics hiding (UInt)
import GHC.TypeNats hiding (Mod)
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 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)
infixr |?
_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)
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
(.=?) :: (J.KeyValue kv, J.ToJSON v) => String -> Maybe v -> [kv]
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