{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}

-- | Common types that aren't in the specification
module Language.LSP.Protocol.Types.Common (
  type (|?) (..),
  toEither,
  _L,
  _R,
  Int32,
  UInt,
  Null (..),
  absorbNull,
  nullToMaybe,
  maybeToNull,
  (.=?),
  (.:!?),
) where

import Control.Applicative
import Control.DeepSeq
import Control.Lens
import Data.Aeson hiding (Null)
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Types qualified as J
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))

{- | The "uinteger" type in the LSP spec.

 Unusually, this is a **31**-bit unsigned integer, not a 32-bit one.
-}
newtype UInt = UInt (Mod (2 ^ 31))
  deriving newtype (Integer -> UInt
UInt -> UInt
UInt -> UInt -> UInt
(UInt -> UInt -> UInt)
-> (UInt -> UInt -> UInt)
-> (UInt -> UInt -> UInt)
-> (UInt -> UInt)
-> (UInt -> UInt)
-> (UInt -> UInt)
-> (Integer -> UInt)
-> Num UInt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UInt -> UInt -> UInt
+ :: UInt -> UInt -> UInt
$c- :: UInt -> UInt -> UInt
- :: UInt -> UInt -> UInt
$c* :: UInt -> UInt -> UInt
* :: UInt -> UInt -> UInt
$cnegate :: UInt -> UInt
negate :: UInt -> UInt
$cabs :: UInt -> UInt
abs :: UInt -> UInt
$csignum :: UInt -> UInt
signum :: UInt -> UInt
$cfromInteger :: Integer -> UInt
fromInteger :: Integer -> UInt
Num, UInt
UInt -> UInt -> Bounded UInt
forall a. a -> a -> Bounded a
$cminBound :: UInt
minBound :: UInt
$cmaxBound :: UInt
maxBound :: UInt
Bounded, Int -> UInt
UInt -> Int
UInt -> [UInt]
UInt -> UInt
UInt -> UInt -> [UInt]
UInt -> UInt -> UInt -> [UInt]
(UInt -> UInt)
-> (UInt -> UInt)
-> (Int -> UInt)
-> (UInt -> Int)
-> (UInt -> [UInt])
-> (UInt -> UInt -> [UInt])
-> (UInt -> UInt -> [UInt])
-> (UInt -> UInt -> UInt -> [UInt])
-> Enum 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
$csucc :: UInt -> UInt
succ :: UInt -> UInt
$cpred :: UInt -> UInt
pred :: UInt -> UInt
$ctoEnum :: Int -> UInt
toEnum :: Int -> UInt
$cfromEnum :: UInt -> Int
fromEnum :: UInt -> Int
$cenumFrom :: UInt -> [UInt]
enumFrom :: UInt -> [UInt]
$cenumFromThen :: UInt -> UInt -> [UInt]
enumFromThen :: UInt -> UInt -> [UInt]
$cenumFromTo :: UInt -> UInt -> [UInt]
enumFromTo :: UInt -> UInt -> [UInt]
$cenumFromThenTo :: UInt -> UInt -> UInt -> [UInt]
enumFromThenTo :: UInt -> UInt -> UInt -> [UInt]
Enum, UInt -> UInt -> Bool
(UInt -> UInt -> Bool) -> (UInt -> UInt -> Bool) -> Eq UInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UInt -> UInt -> Bool
== :: UInt -> UInt -> Bool
$c/= :: UInt -> UInt -> Bool
/= :: UInt -> UInt -> Bool
Eq, Eq UInt
Eq UInt =>
(UInt -> UInt -> Ordering)
-> (UInt -> UInt -> Bool)
-> (UInt -> UInt -> Bool)
-> (UInt -> UInt -> Bool)
-> (UInt -> UInt -> Bool)
-> (UInt -> UInt -> UInt)
-> (UInt -> UInt -> UInt)
-> Ord 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
$ccompare :: UInt -> UInt -> Ordering
compare :: UInt -> UInt -> Ordering
$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
>= :: UInt -> UInt -> Bool
$cmax :: UInt -> UInt -> UInt
max :: UInt -> UInt -> UInt
$cmin :: UInt -> UInt -> UInt
min :: UInt -> UInt -> UInt
Ord)
  deriving stock ((forall x. UInt -> Rep UInt x)
-> (forall x. Rep UInt x -> UInt) -> Generic UInt
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
$cfrom :: forall x. UInt -> Rep UInt x
from :: forall x. UInt -> Rep UInt x
$cto :: forall x. Rep UInt x -> UInt
to :: forall x. Rep UInt x -> UInt
Generic)
  deriving anyclass (UInt -> ()
(UInt -> ()) -> NFData UInt
forall a. (a -> ()) -> NFData a
$crnf :: UInt -> ()
rnf :: UInt -> ()
NFData)

instance Hashable UInt where hashWithSalt :: Int -> UInt -> Int
hashWithSalt Int
s (UInt Mod (2 ^ 31)
n) = Int -> Word -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
n)

instance Show UInt where
  show :: UInt -> String
show (UInt Mod (2 ^ 31)
u) = Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
u

instance Read UInt where
  readPrec :: ReadPrec UInt
readPrec = Integer -> UInt
forall a. Num a => Integer -> a
fromInteger (Integer -> UInt) -> ReadPrec Integer -> ReadPrec UInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Integer
forall a. Read a => ReadPrec a
readPrec

instance Pretty UInt where
  pretty :: forall ann. UInt -> Doc ann
pretty = UInt -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance Real UInt where
  toRational :: UInt -> Rational
toRational (UInt Mod (2 ^ 31)
u) = Word -> Rational
forall a. Real a => a -> Rational
toRational (Word -> Rational) -> Word -> Rational
forall a b. (a -> b) -> a -> b
$ Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
u

instance Integral UInt where
  quotRem :: UInt -> UInt -> (UInt, UInt)
quotRem (UInt Mod (2 ^ 31)
x) (UInt Mod (2 ^ 31)
y) = (Word -> UInt) -> (Word -> UInt) -> (Word, Word) -> (UInt, UInt)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word, Word) -> (UInt, UInt)) -> (Word, Word) -> (UInt, UInt)
forall a b. (a -> b) -> a -> b
$ Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
quotRem (Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
x) (Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
y)
  toInteger :: UInt -> Integer
toInteger (UInt Mod (2 ^ 31)
u) = Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$ Mod 2147483648 -> Word
forall (m :: Nat). Mod m -> Word
unMod Mod 2147483648
Mod (2 ^ 31)
u

instance ToJSON UInt where
  toJSON :: UInt -> Value
toJSON UInt
u = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (UInt -> Integer
forall a. Integral a => a -> Integer
toInteger UInt
u)

instance FromJSON UInt where
  parseJSON :: Value -> Parser UInt
parseJSON Value
v = Integer -> UInt
forall a. Num a => Integer -> a
fromInteger (Integer -> UInt) -> Parser Integer -> Parser UInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

{- | An alternative type (isomorphic to 'Either'), but which
 is encoded into JSON without a tag for the alternative.

 This corresponds to @a | b@ types in the LSP specification.
-}
data a |? b
  = InL a
  | InR b
  deriving stock (ReadPrec [a |? b]
ReadPrec (a |? b)
Int -> ReadS (a |? b)
ReadS [a |? b]
(Int -> ReadS (a |? b))
-> ReadS [a |? b]
-> ReadPrec (a |? b)
-> ReadPrec [a |? b]
-> Read (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]
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (a |? b)
readsPrec :: Int -> ReadS (a |? b)
$creadList :: forall a b. (Read a, Read b) => ReadS [a |? b]
readList :: ReadS [a |? b]
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (a |? b)
readPrec :: ReadPrec (a |? b)
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [a |? b]
readListPrec :: ReadPrec [a |? b]
Read, Int -> (a |? b) -> ShowS
[a |? b] -> ShowS
(a |? b) -> String
(Int -> (a |? b) -> ShowS)
-> ((a |? b) -> String) -> ([a |? b] -> ShowS) -> Show (a |? b)
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
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a |? b) -> ShowS
showsPrec :: Int -> (a |? b) -> ShowS
$cshow :: forall a b. (Show a, Show b) => (a |? b) -> String
show :: (a |? b) -> String
$cshowList :: forall a b. (Show a, Show b) => [a |? b] -> ShowS
showList :: [a |? b] -> ShowS
Show, (a |? b) -> (a |? b) -> Bool
((a |? b) -> (a |? b) -> Bool)
-> ((a |? b) -> (a |? b) -> Bool) -> Eq (a |? b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (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
/= :: (a |? b) -> (a |? b) -> Bool
Eq, Eq (a |? b)
Eq (a |? b) =>
((a |? b) -> (a |? b) -> Ordering)
-> ((a |? b) -> (a |? b) -> Bool)
-> ((a |? b) -> (a |? b) -> Bool)
-> ((a |? b) -> (a |? b) -> Bool)
-> ((a |? b) -> (a |? b) -> Bool)
-> ((a |? b) -> (a |? b) -> a |? b)
-> ((a |? b) -> (a |? b) -> a |? b)
-> Ord (a |? b)
(a |? b) -> (a |? b) -> Bool
(a |? b) -> (a |? b) -> Ordering
(a |? b) -> (a |? b) -> a |? b
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
$ccompare :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> Ordering
compare :: (a |? b) -> (a |? b) -> Ordering
$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
>= :: (a |? b) -> (a |? b) -> Bool
$cmax :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> a |? b
max :: (a |? b) -> (a |? b) -> a |? b
$cmin :: forall a b. (Ord a, Ord b) => (a |? b) -> (a |? b) -> a |? b
min :: (a |? b) -> (a |? b) -> a |? b
Ord, (forall x. (a |? b) -> Rep (a |? b) x)
-> (forall x. Rep (a |? b) x -> a |? b) -> Generic (a |? b)
forall x. Rep (a |? b) x -> a |? b
forall x. (a |? b) -> Rep (a |? b) x
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
$cfrom :: forall a b x. (a |? b) -> Rep (a |? b) x
from :: forall x. (a |? b) -> Rep (a |? b) x
$cto :: forall a b x. Rep (a |? b) x -> a |? b
to :: forall x. Rep (a |? b) x -> a |? b
Generic)
  deriving anyclass ((a |? b) -> ()
((a |? b) -> ()) -> NFData (a |? b)
forall a. (a -> ()) -> NFData a
forall a b. (NFData a, NFData b) => (a |? b) -> ()
$crnf :: forall a b. (NFData a, NFData b) => (a |? b) -> ()
rnf :: (a |? b) -> ()
NFData, Eq (a |? b)
Eq (a |? b) =>
(Int -> (a |? b) -> Int) -> ((a |? b) -> Int) -> Hashable (a |? b)
Int -> (a |? b) -> Int
(a |? b) -> Int
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
$chashWithSalt :: forall a b. (Hashable a, Hashable b) => Int -> (a |? b) -> Int
hashWithSalt :: Int -> (a |? b) -> Int
$chash :: forall a b. (Hashable a, Hashable b) => (a |? b) -> Int
hash :: (a |? b) -> Int
Hashable)
  deriving ((forall ann. (a |? b) -> Doc ann)
-> (forall ann. [a |? b] -> Doc ann) -> Pretty (a |? b)
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
$cpretty :: forall a b ann. (ToJSON a, ToJSON b) => (a |? b) -> Doc ann
pretty :: forall ann. (a |? b) -> Doc ann
$cprettyList :: forall a b ann. (ToJSON a, ToJSON b) => [a |? b] -> Doc ann
prettyList :: forall ann. [a |? b] -> Doc ann
Pretty) via (ViaJSON (a |? b))

infixr 9 |?

-- | Prism for the left-hand side of an '(|?)'.
_L :: Prism' (a |? b) a
_L :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f a) -> p (a |? b) (f (a |? b))
_L = (a -> a |? b)
-> ((a |? b) -> Maybe a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f a) -> p (a |? b) (f (a |? b))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> a |? b
forall a b. a -> a |? b
InL (((a |? b) -> Maybe a)
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p a (f a) -> p (a |? b) (f (a |? b)))
-> ((a |? b) -> Maybe a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f a) -> p (a |? b) (f (a |? b))
forall a b. (a -> b) -> a -> b
$ \case
  InL a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  InR b
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Prism for the right-hand side of an '(|?)'.
_R :: Prism' (a |? b) b
_R :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p b (f b) -> p (a |? b) (f (a |? b))
_R = (b -> a |? b)
-> ((a |? b) -> Maybe b)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p b (f b) -> p (a |? b) (f (a |? b))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' b -> a |? b
forall a b. b -> a |? b
InR (((a |? b) -> Maybe b)
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p b (f b) -> p (a |? b) (f (a |? b)))
-> ((a |? b) -> Maybe b)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p b (f b) -> p (a |? b) (f (a |? b))
forall a b. (a -> b) -> a -> b
$ \case
  InL a
_ -> Maybe b
forall a. Maybe a
Nothing
  InR b
b -> b -> Maybe 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) = a -> Either a b
forall a b. a -> Either a b
Left a
a
toEither (InR b
b) = b -> Either a 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) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
  toJSON (InR b
x) = b -> Value
forall a. ToJSON a => a -> Value
toJSON b
x

instance (FromJSON a, ToJSON a, FromJSON b, ToJSON b) => FromJSON (a |? b) where
  -- Truly atrocious and abominable hack. The issue is tha we may have siutations
  -- where some input JSON can parse correctly as both sides of the union, because
  -- we have no tag. What do we do in this situation? It's very unclear, and the
  -- spec is no help. The heuristic we adopt here is that it is better to take
  -- the version with "more fields". How do we work that out? By converting back
  -- to JSON and looking at the object fields.
  --
  -- Possibly we could do better by relying on Generic instances for a and b
  -- in order to work out which has more fields on the Haskell side.
  parseJSON :: Value -> Parser (a |? b)
parseJSON Value
v = do
    let Result a
ra :: Result a = Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v
        Result b
rb :: Result b = Value -> 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
_) -> (a |? b) -> Parser (a |? b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a |? b) -> Parser (a |? b)) -> (a |? b) -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ a -> a |? b
forall a b. a -> a |? b
InL a
a
      (Error String
_, Success b
b) -> (a |? b) -> Parser (a |? b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a |? b) -> Parser (a |? b)) -> (a |? b) -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ b -> a |? b
forall a b. b -> a |? b
InR b
b
      (Error String
e, Error String
_) -> String -> Parser (a |? b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      (Success a
a, Success b
b) -> case (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b) of
        -- Both sides encode to the same thing, just pick one arbitrarily
        (Value
l, Value
r) | Value
l Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
r -> (a |? b) -> Parser (a |? b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a |? b) -> Parser (a |? b)) -> (a |? b) -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ a -> a |? b
forall a b. a -> a |? b
InL a
a
        (Object Object
oa, Object Object
ob) ->
          let ka :: Set Key
ka = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList ([Key] -> Set Key) -> [Key] -> Set Key
forall a b. (a -> b) -> a -> b
$ Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
oa
              kb :: Set Key
kb = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList ([Key] -> Set Key) -> [Key] -> Set Key
forall a b. (a -> b) -> a -> b
$ Object -> [Key]
forall v. KeyMap v -> [Key]
KM.keys Object
ob
           in if Set Key
kb Set Key -> Set Key -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Key
ka
                then (a |? b) -> Parser (a |? b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a |? b) -> Parser (a |? b)) -> (a |? b) -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ a -> a |? b
forall a b. a -> a |? b
InL a
a
                else
                  if Set Key
ka Set Key -> Set Key -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Key
kb
                    then (a |? b) -> Parser (a |? b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a |? b) -> Parser (a |? b)) -> (a |? b) -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ b -> a |? b
forall a b. b -> a |? b
InR b
b
                    else String -> Parser (a |? b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a |? b)) -> String -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ String
"Could not decide which type of value to produce, left encodes to an object with keys: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set Key -> String
forall a. Show a => a -> String
show Set Key
ka String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; right has keys " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set Key -> String
forall a. Show a => a -> String
show Set Key
kb
        (Value
l, Value
r) -> String -> Parser (a |? b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (a |? b)) -> String -> Parser (a |? b)
forall a b. (a -> b) -> a -> b
$ String
"Could not decide which type of value to produce, left encodes to: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; right encodes to: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
r

-- We could use 'Proxy' for this, as aeson also serializes it to/from null,
-- but this is more explicit.

{- | A type for that is precisely null and nothing else.

 This is useful since the LSP specification often includes types like @a | null@
 as distinct from an optional value of type @a@.
-}
data Null = Null
  deriving stock (Null -> Null -> Bool
(Null -> Null -> Bool) -> (Null -> Null -> Bool) -> Eq Null
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Null -> Null -> Bool
== :: Null -> Null -> Bool
$c/= :: Null -> Null -> Bool
/= :: Null -> Null -> Bool
Eq, Eq Null
Eq Null =>
(Null -> Null -> Ordering)
-> (Null -> Null -> Bool)
-> (Null -> Null -> Bool)
-> (Null -> Null -> Bool)
-> (Null -> Null -> Bool)
-> (Null -> Null -> Null)
-> (Null -> Null -> Null)
-> Ord 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
$ccompare :: Null -> Null -> Ordering
compare :: Null -> Null -> Ordering
$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
>= :: Null -> Null -> Bool
$cmax :: Null -> Null -> Null
max :: Null -> Null -> Null
$cmin :: Null -> Null -> Null
min :: Null -> Null -> Null
Ord, Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
(Int -> Null -> ShowS)
-> (Null -> String) -> ([Null] -> ShowS) -> Show Null
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Null -> ShowS
showsPrec :: Int -> Null -> ShowS
$cshow :: Null -> String
show :: Null -> String
$cshowList :: [Null] -> ShowS
showList :: [Null] -> ShowS
Show, (forall x. Null -> Rep Null x)
-> (forall x. Rep Null x -> Null) -> Generic Null
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
$cfrom :: forall x. Null -> Rep Null x
from :: forall x. Null -> Rep Null x
$cto :: forall x. Rep Null x -> Null
to :: forall x. Rep Null x -> Null
Generic)
  deriving anyclass (Null -> ()
(Null -> ()) -> NFData Null
forall a. (a -> ()) -> NFData a
$crnf :: Null -> ()
rnf :: Null -> ()
NFData, Eq Null
Eq Null => (Int -> Null -> Int) -> (Null -> Int) -> Hashable Null
Int -> Null -> Int
Null -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Null -> Int
hashWithSalt :: Int -> Null -> Int
$chash :: Null -> Int
hash :: Null -> Int
Hashable)
  deriving ((forall ann. Null -> Doc ann)
-> (forall ann. [Null] -> Doc ann) -> Pretty Null
forall ann. [Null] -> Doc ann
forall ann. Null -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. Null -> Doc ann
pretty :: forall ann. Null -> Doc ann
$cprettyList :: forall ann. [Null] -> Doc ann
prettyList :: 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 = Null -> Parser Null
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Null
Null
  parseJSON Value
_ = String -> Parser Null
forall a. String -> Parser a
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
_) = a
forall a. Monoid a => a
mempty

nullToMaybe :: a |? Null -> Maybe a
nullToMaybe :: forall a. (a |? Null) -> Maybe a
nullToMaybe (InL a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
nullToMaybe (InR Null
_) = Maybe a
forall a. Maybe a
Nothing

maybeToNull :: Maybe a -> a |? Null
maybeToNull :: forall a. Maybe a -> a |? Null
maybeToNull (Just a
x) = a -> a |? Null
forall a b. a -> a |? b
InL a
x
maybeToNull Maybe a
Nothing = Null -> a |? Null
forall a b. b -> a |? b
InR Null
Null

-- This is equivalent to the instance for 'Maybe s'
instance Semigroup s => Semigroup (s |? Null) where
  InL s
x <> :: (s |? Null) -> (s |? Null) -> s |? Null
<> InL s
y = s -> s |? Null
forall a b. a -> a |? b
InL (s
x s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
y)
  InL s
x <> InR Null
_ = s -> s |? Null
forall a b. a -> a |? b
InL s
x
  InR Null
_ <> InL s
x = s -> s |? Null
forall a b. a -> a |? b
InL s
x
  InR Null
_ <> InR Null
y = Null -> s |? Null
forall a b. b -> a |? b
InR Null
y

-- We use String so we can use fromString on it to get a key that works
-- in both aeson-1 and aeson-2

-- | Include a value in an JSON object optionally, omitting it if it is 'Nothing'.
#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 e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
.=? Maybe v
v = case Maybe v
v of
  Just v
v' -> [String -> Key
forall a. IsString a => String -> a
fromString String
k Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
J..= v
v']
  Maybe v
Nothing -> [kv]
forall a. Monoid a => a
mempty

{- |
Parse a value optionally. This behaves similarly to 'J..:!' and
'J..:?', but differs in how it handles 'Null':

    * If 'Null' can be converted to the desired type...
        * 'J.:?': the result is success with 'Nothing'
        * 'J.:!': the result is success with 'Just <value>'
        * '.:!?': the result is success with 'Just <value>'
    * If 'Null' cannot be converted to the desired type...
        * 'J.:?': the result is success with 'Nothing'
        * 'J.:!': the result is failure
        * '.:!?': the result is success with 'Nothing'

That is, we allow 'Null' to mean either 'Nothing' or 'Just <value>',
with the latter taking priority.
-}
(.:!?) :: (J.FromJSON v) => Object -> Key -> J.Parser (Maybe v)
Object
o .:!? :: forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
.:!? Key
k =
  -- If 'Null' can be converted to the desired type this succeeds
  -- with Just the converted value
  Object
o Object -> Key -> Parser (Maybe v)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
J..:! Key
k
    -- otherwise...
    Parser (Maybe v) -> Parser (Maybe v) -> Parser (Maybe v)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- If 'Null' cannot be converted to the desired type this succeeds
    -- with Nothing
    Object
o Object -> Key -> Parser (Maybe v)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
J..:? Key
k