{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}

-- | 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.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))

{- | 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
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

{- | 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)
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 |?

-- | Prism for the left-hand side of an '(|?)'.
_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

-- | Prism for the right-hand side of an '(|?)'.
_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
  -- 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 = 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
        -- Both sides encode to the same thing, just pick one arbitrarily
        (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

-- 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
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

-- 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 = 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

-- 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 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