-- | Internal utilities and instances
module Calamity.Internal.Utils (
  whileMFinalIO,
  untilJustFinalIO,
  whenJust,
  whenM,
  unlessM,
  lastMaybe,
  leftToMaybe,
  rightToMaybe,
  justToEither,
  (<<$>>),
  (<<*>>),
  (<.>),
  (.?=),
  (.=),
  debug,
  info,
  Calamity.Internal.Utils.error,
  swap,
  DefaultingMap (..),
  AesonVector (..),
  CalamityFromStringShow (..),
  MaybeNull (..),
  CalamityToJSON (..),
  CalamityToJSON' (..),
) where

import Calamity.Internal.RunIntoIO
import Calamity.Types.LogEff
import Control.Applicative
import Data.Aeson qualified as Aeson
import Data.Aeson.Encoding (null_)
import Data.Default.Class
import Data.Map qualified as M
import Data.Maybe (catMaybes)
import Data.Semigroup (Last (..))
import Data.Text
import Data.Vector.Unboxing qualified as VU
import DiPolysemy qualified as Di
import Polysemy qualified as P
import TextShow

{- | Like whileM, but stateful effects are not preserved to mitigate memory leaks

 This means Polysemy.Error won't work to break the loop, etc.
 Instead, Error/Alternative will just result in the loop quitting.
-}
whileMFinalIO :: P.Member (P.Final IO) r => P.Sem r Bool -> P.Sem r ()
whileMFinalIO :: forall (r :: EffectRow).
Member (Final IO) r =>
Sem r Bool -> Sem r ()
whileMFinalIO Sem r Bool
action = do
  IO (Maybe Bool)
action' <- Sem r Bool -> Sem r (IO (Maybe Bool))
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem r a -> Sem r (IO (Maybe a))
runSemToIO Sem r Bool
action
  IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
P.embedFinal (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IO (Maybe Bool) -> IO ()
forall {m :: * -> *}. Monad m => m (Maybe Bool) -> m ()
go IO (Maybe Bool)
action'
  where
    go :: m (Maybe Bool) -> m ()
go m (Maybe Bool)
action' = do
      Maybe Bool
r <- m (Maybe Bool)
action'
      case Maybe Bool
r of
        Just Bool
True ->
          m (Maybe Bool) -> m ()
go m (Maybe Bool)
action'
        Maybe Bool
_ ->
          () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | Like untilJust, but stateful effects are not preserved to mitigate memory leaks

 This means Polysemy.Error won't work to break the loop, etc.
 Instead, Error/Alternative will just result in another loop.
-}
untilJustFinalIO :: P.Member (P.Final IO) r => P.Sem r (Maybe a) -> P.Sem r a
untilJustFinalIO :: forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem r (Maybe a) -> Sem r a
untilJustFinalIO Sem r (Maybe a)
action = do
  IO (Maybe (Maybe a))
action' <- Sem r (Maybe a) -> Sem r (IO (Maybe (Maybe a)))
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem r a -> Sem r (IO (Maybe a))
runSemToIO Sem r (Maybe a)
action
  IO a -> Sem r a
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
P.embedFinal (IO a -> Sem r a) -> IO a -> Sem r a
forall a b. (a -> b) -> a -> b
$ IO (Maybe (Maybe a)) -> IO a
forall {m :: * -> *} {b}. Monad m => m (Maybe (Maybe b)) -> m b
go IO (Maybe (Maybe a))
action'
  where
    go :: m (Maybe (Maybe b)) -> m b
go m (Maybe (Maybe b))
action' = do
      Maybe (Maybe b)
r <- m (Maybe (Maybe b))
action'
      case Maybe (Maybe b)
r of
        Just (Just b
a) ->
          b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
        Maybe (Maybe b)
_ ->
          m (Maybe (Maybe b)) -> m b
go m (Maybe (Maybe b))
action'

whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust = ((a -> m ()) -> Maybe a -> m ()) -> Maybe a -> (a -> m ()) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> m ()) -> Maybe a -> m ())
 -> Maybe a -> (a -> m ()) -> m ())
-> ((a -> m ()) -> Maybe a -> m ())
-> Maybe a
-> (a -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
p m ()
m =
  m Bool
p m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> m ()
m
    Bool
False -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> m () -> m ())
-> (m Bool -> m Bool) -> m Bool -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

lastMaybe :: Maybe a -> Maybe a -> Maybe a
lastMaybe :: forall a. Maybe a -> Maybe a -> Maybe a
lastMaybe Maybe a
l Maybe a
r = Last a -> a
forall a. Last a -> a
getLast (Last a -> a) -> Maybe (Last a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Last a) -> Maybe a -> Maybe (Last a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
Last Maybe a
l Maybe (Last a) -> Maybe (Last a) -> Maybe (Last a)
forall a. Semigroup a => a -> a -> a
<> (a -> Last a) -> Maybe a -> Maybe (Last a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
Last Maybe a
r

leftToMaybe :: Either e a -> Maybe e
leftToMaybe :: forall e a. Either e a -> Maybe e
leftToMaybe (Left e
x) = e -> Maybe e
forall a. a -> Maybe a
Just e
x
leftToMaybe Either e a
_ = Maybe e
forall a. Maybe a
Nothing

rightToMaybe :: Either e a -> Maybe a
rightToMaybe :: forall e a. Either e a -> Maybe a
rightToMaybe (Right a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
rightToMaybe Either e a
_ = Maybe a
forall a. Maybe a
Nothing

justToEither :: Maybe e -> Either e ()
justToEither :: forall e. Maybe e -> Either e ()
justToEither (Just e
x) = e -> Either e ()
forall a b. a -> Either a b
Left e
x
justToEither Maybe e
_ = () -> Either e ()
forall a b. b -> Either a b
Right ()

(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
<<$>> :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(<<$>>) = (g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g a -> g b) -> f (g a) -> f (g b))
-> ((a -> b) -> g a -> g b) -> (a -> b) -> f (g a) -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

infixl 4 <<$>>

(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)
<<*>> :: forall (f :: * -> *) (g :: * -> *) a b.
(Applicative f, Applicative g) =>
f (g (a -> b)) -> f (g a) -> f (g b)
(<<*>>) = (g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a) -> f (g b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 g (a -> b) -> g a -> g b
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

infixl 4 <<*>>

(<.>) :: Functor f => (a -> b) -> (c -> f a) -> (c -> f b)
<.> :: forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
(<.>) a -> b
f c -> f a
g c
x = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f a
g c
x

infixl 4 <.>

debug :: P.Member LogEff r => Text -> P.Sem r ()
debug :: forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
debug = Text -> Sem r ()
forall msg path (r :: EffectRow).
(ToMessage msg, Member (Di Level path Message) r) =>
msg -> Sem r ()
Di.debug

info :: P.Member LogEff r => Text -> P.Sem r ()
info :: forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
info = Text -> Sem r ()
forall msg path (r :: EffectRow).
(ToMessage msg, Member (Di Level path Message) r) =>
msg -> Sem r ()
Di.info

error :: P.Member LogEff r => Text -> P.Sem r ()
error :: forall (r :: EffectRow). Member LogEff r => Text -> Sem r ()
error = Text -> Sem r ()
forall msg path (r :: EffectRow).
(ToMessage msg, Member (Di Level path Message) r) =>
msg -> Sem r ()
Di.error

swap :: (a, b) -> (b, a)
swap :: forall a b. (a, b) -> (b, a)
swap ~(a
a, b
b) = (b
b, a
a)

newtype DefaultingMap k v = DefaultingMap {forall k v. DefaultingMap k v -> Map k v
unDefaultingMap :: M.Map k v}

instance Default (DefaultingMap k v) where
  def :: DefaultingMap k v
def = Map k v -> DefaultingMap k v
forall k v. Map k v -> DefaultingMap k v
DefaultingMap Map k v
forall k a. Map k a
M.empty

newtype AesonVector a = AesonVector {forall a. AesonVector a -> Vector a
unAesonVector :: VU.Vector a}
  deriving (Int -> AesonVector a -> ShowS
[AesonVector a] -> ShowS
AesonVector a -> String
(Int -> AesonVector a -> ShowS)
-> (AesonVector a -> String)
-> ([AesonVector a] -> ShowS)
-> Show (AesonVector a)
forall a. (Show a, Unboxable a) => Int -> AesonVector a -> ShowS
forall a. (Show a, Unboxable a) => [AesonVector a] -> ShowS
forall a. (Show a, Unboxable a) => AesonVector a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. (Show a, Unboxable a) => Int -> AesonVector a -> ShowS
showsPrec :: Int -> AesonVector a -> ShowS
$cshow :: forall a. (Show a, Unboxable a) => AesonVector a -> String
show :: AesonVector a -> String
$cshowList :: forall a. (Show a, Unboxable a) => [AesonVector a] -> ShowS
showList :: [AesonVector a] -> ShowS
Show) via VU.Vector a

instance (Aeson.FromJSON a, VU.Unboxable a) => Aeson.FromJSON (AesonVector a) where
  parseJSON :: Value -> Parser (AesonVector a)
parseJSON = (Vector a -> AesonVector a
forall a. Vector a -> AesonVector a
AesonVector (Vector a -> AesonVector a)
-> ([a] -> Vector a) -> [a] -> AesonVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. Unboxable a => [a] -> Vector a
VU.fromList ([a] -> AesonVector a) -> Parser [a] -> Parser (AesonVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser [a] -> Parser (AesonVector a))
-> (Value -> Parser [a]) -> Value -> Parser (AesonVector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

instance (Aeson.ToJSON a, VU.Unboxable a) => Aeson.ToJSON (AesonVector a) where
  toJSON :: AesonVector a -> Value
toJSON = [a] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([a] -> Value) -> (AesonVector a -> [a]) -> AesonVector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unboxable a => Vector a -> [a]
VU.toList (Vector a -> [a])
-> (AesonVector a -> Vector a) -> AesonVector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonVector a -> Vector a
forall a. AesonVector a -> Vector a
unAesonVector
  toEncoding :: AesonVector a -> Encoding
toEncoding = [a] -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding ([a] -> Encoding)
-> (AesonVector a -> [a]) -> AesonVector a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unboxable a => Vector a -> [a]
VU.toList (Vector a -> [a])
-> (AesonVector a -> Vector a) -> AesonVector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonVector a -> Vector a
forall a. AesonVector a -> Vector a
unAesonVector

instance (TextShow a, VU.Unboxable a) => TextShow (AesonVector a) where
  showb :: AesonVector a -> Builder
showb = [a] -> Builder
forall a. TextShow a => [a] -> Builder
showbList ([a] -> Builder)
-> (AesonVector a -> [a]) -> AesonVector a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unboxable a => Vector a -> [a]
VU.toList (Vector a -> [a])
-> (AesonVector a -> Vector a) -> AesonVector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesonVector a -> Vector a
forall a. AesonVector a -> Vector a
unAesonVector

newtype CalamityFromStringShow a = CalamityFromStringShow {forall a. CalamityFromStringShow a -> a
unCalamityFromStringShow :: a}
  deriving (Value -> Parser [CalamityFromStringShow a]
Value -> Parser (CalamityFromStringShow a)
(Value -> Parser (CalamityFromStringShow a))
-> (Value -> Parser [CalamityFromStringShow a])
-> FromJSON (CalamityFromStringShow a)
forall a. FromJSON a => Value -> Parser [CalamityFromStringShow a]
forall a. FromJSON a => Value -> Parser (CalamityFromStringShow a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (CalamityFromStringShow a)
parseJSON :: Value -> Parser (CalamityFromStringShow a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [CalamityFromStringShow a]
parseJSONList :: Value -> Parser [CalamityFromStringShow a]
Aeson.FromJSON, [CalamityFromStringShow a] -> Value
[CalamityFromStringShow a] -> Encoding
CalamityFromStringShow a -> Value
CalamityFromStringShow a -> Encoding
(CalamityFromStringShow a -> Value)
-> (CalamityFromStringShow a -> Encoding)
-> ([CalamityFromStringShow a] -> Value)
-> ([CalamityFromStringShow a] -> Encoding)
-> ToJSON (CalamityFromStringShow a)
forall a. ToJSON a => [CalamityFromStringShow a] -> Value
forall a. ToJSON a => [CalamityFromStringShow a] -> Encoding
forall a. ToJSON a => CalamityFromStringShow a -> Value
forall a. ToJSON a => CalamityFromStringShow a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => CalamityFromStringShow a -> Value
toJSON :: CalamityFromStringShow a -> Value
$ctoEncoding :: forall a. ToJSON a => CalamityFromStringShow a -> Encoding
toEncoding :: CalamityFromStringShow a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [CalamityFromStringShow a] -> Value
toJSONList :: [CalamityFromStringShow a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [CalamityFromStringShow a] -> Encoding
toEncodingList :: [CalamityFromStringShow a] -> Encoding
Aeson.ToJSON) via a
  deriving (Int -> CalamityFromStringShow a -> Text
Int -> CalamityFromStringShow a -> Builder
Int -> CalamityFromStringShow a -> Text
[CalamityFromStringShow a] -> Text
[CalamityFromStringShow a] -> Builder
[CalamityFromStringShow a] -> Text
CalamityFromStringShow a -> Text
CalamityFromStringShow a -> Builder
CalamityFromStringShow a -> Text
(Int -> CalamityFromStringShow a -> Builder)
-> (CalamityFromStringShow a -> Builder)
-> ([CalamityFromStringShow a] -> Builder)
-> (Int -> CalamityFromStringShow a -> Text)
-> (CalamityFromStringShow a -> Text)
-> ([CalamityFromStringShow a] -> Text)
-> (Int -> CalamityFromStringShow a -> Text)
-> (CalamityFromStringShow a -> Text)
-> ([CalamityFromStringShow a] -> Text)
-> TextShow (CalamityFromStringShow a)
forall a. Show a => Int -> CalamityFromStringShow a -> Text
forall a. Show a => Int -> CalamityFromStringShow a -> Builder
forall a. Show a => Int -> CalamityFromStringShow a -> Text
forall a. Show a => [CalamityFromStringShow a] -> Text
forall a. Show a => [CalamityFromStringShow a] -> Builder
forall a. Show a => [CalamityFromStringShow a] -> Text
forall a. Show a => CalamityFromStringShow a -> Text
forall a. Show a => CalamityFromStringShow a -> Builder
forall a. Show a => CalamityFromStringShow a -> Text
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: forall a. Show a => Int -> CalamityFromStringShow a -> Builder
showbPrec :: Int -> CalamityFromStringShow a -> Builder
$cshowb :: forall a. Show a => CalamityFromStringShow a -> Builder
showb :: CalamityFromStringShow a -> Builder
$cshowbList :: forall a. Show a => [CalamityFromStringShow a] -> Builder
showbList :: [CalamityFromStringShow a] -> Builder
$cshowtPrec :: forall a. Show a => Int -> CalamityFromStringShow a -> Text
showtPrec :: Int -> CalamityFromStringShow a -> Text
$cshowt :: forall a. Show a => CalamityFromStringShow a -> Text
showt :: CalamityFromStringShow a -> Text
$cshowtList :: forall a. Show a => [CalamityFromStringShow a] -> Text
showtList :: [CalamityFromStringShow a] -> Text
$cshowtlPrec :: forall a. Show a => Int -> CalamityFromStringShow a -> Text
showtlPrec :: Int -> CalamityFromStringShow a -> Text
$cshowtl :: forall a. Show a => CalamityFromStringShow a -> Text
showtl :: CalamityFromStringShow a -> Text
$cshowtlList :: forall a. Show a => [CalamityFromStringShow a] -> Text
showtlList :: [CalamityFromStringShow a] -> Text
TextShow) via FromStringShow a

{- | An alternative 'Maybe' type that allows us to distinguish between parsed
 json fields that were null, and fields that didn't exist.
-}
data MaybeNull a
  = WasNull
  | NotNull a
  deriving (Int -> MaybeNull a -> ShowS
[MaybeNull a] -> ShowS
MaybeNull a -> String
(Int -> MaybeNull a -> ShowS)
-> (MaybeNull a -> String)
-> ([MaybeNull a] -> ShowS)
-> Show (MaybeNull a)
forall a. Show a => Int -> MaybeNull a -> ShowS
forall a. Show a => [MaybeNull a] -> ShowS
forall a. Show a => MaybeNull a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MaybeNull a -> ShowS
showsPrec :: Int -> MaybeNull a -> ShowS
$cshow :: forall a. Show a => MaybeNull a -> String
show :: MaybeNull a -> String
$cshowList :: forall a. Show a => [MaybeNull a] -> ShowS
showList :: [MaybeNull a] -> ShowS
Show)

instance Aeson.FromJSON a => Aeson.FromJSON (MaybeNull a) where
  parseJSON :: Value -> Parser (MaybeNull a)
parseJSON Value
Aeson.Null = MaybeNull a -> Parser (MaybeNull a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaybeNull a
forall a. MaybeNull a
WasNull
  parseJSON Value
x = a -> MaybeNull a
forall a. a -> MaybeNull a
NotNull (a -> MaybeNull a) -> Parser a -> Parser (MaybeNull a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
x

instance Aeson.ToJSON a => Aeson.ToJSON (MaybeNull a) where
  toJSON :: MaybeNull a -> Value
toJSON MaybeNull a
WasNull = Value
Aeson.Null
  toJSON (NotNull a
x) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x

  toEncoding :: MaybeNull a -> Encoding
toEncoding MaybeNull a
WasNull = Encoding
null_
  toEncoding (NotNull a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
x

(.?=) :: (Aeson.ToJSON v, Aeson.KeyValue kv) => Aeson.Key -> Maybe v -> Maybe kv
Key
k .?= :: forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
.?= Just v
v = kv -> Maybe kv
forall a. a -> Maybe a
Just (Key
k Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
Aeson..= v
v)
Key
_ .?= Maybe v
Nothing = Maybe kv
forall a. Maybe a
Nothing

(.=) :: (Aeson.ToJSON v, Aeson.KeyValue kv) => Aeson.Key -> v -> Maybe kv
Key
k .= :: forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= v
v = kv -> Maybe kv
forall a. a -> Maybe a
Just (Key
k Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
Aeson..= v
v)

class CalamityToJSON' a where
  toPairs :: Aeson.KeyValue kv => a -> [Maybe kv]

newtype CalamityToJSON a = CalamityToJSON a

instance CalamityToJSON' a => Aeson.ToJSON (CalamityToJSON a) where
  toJSON :: CalamityToJSON a -> Value
toJSON (CalamityToJSON a
x) = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> (a -> [Pair]) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Pair] -> [Pair]) -> (a -> [Maybe Pair]) -> a -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Maybe Pair]
forall kv. KeyValue kv => a -> [Maybe kv]
forall a kv. (CalamityToJSON' a, KeyValue kv) => a -> [Maybe kv]
toPairs (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ a
x
  toEncoding :: CalamityToJSON a -> Encoding
toEncoding (CalamityToJSON a
x) = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> (a -> Series) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (a -> [Series]) -> a -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Series] -> [Series]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Series] -> [Series])
-> (a -> [Maybe Series]) -> a -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Maybe Series]
forall kv. KeyValue kv => a -> [Maybe kv]
forall a kv. (CalamityToJSON' a, KeyValue kv) => a -> [Maybe kv]
toPairs (a -> Encoding) -> a -> Encoding
forall a b. (a -> b) -> a -> b
$ a
x