{-|
Module      :  Data.Aeson.Alternative
Stability   : experimental

Utilities for decoding JSON into one of the possible types and handling the
resulting sum type.
-}
module Data.Aeson.Alternative
  ( AlternativeJSON
  , alternative
  ) where

import Control.Applicative

import Data.Aeson

-- | One of the two values that has been parsed from JSON
data AlternativeJSON a b
  = FirstJSON a
  | SecondJSON b
  deriving (AlternativeJSON a b -> AlternativeJSON a b -> Bool
(AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> Eq (AlternativeJSON a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
/= :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
== :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
Eq, Eq (AlternativeJSON a b)
Eq (AlternativeJSON a b)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Ordering)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> (AlternativeJSON a b -> AlternativeJSON a b -> Bool)
-> (AlternativeJSON a b
    -> AlternativeJSON a b -> AlternativeJSON a b)
-> (AlternativeJSON a b
    -> AlternativeJSON a b -> AlternativeJSON a b)
-> Ord (AlternativeJSON a b)
AlternativeJSON a b -> AlternativeJSON a b -> Bool
AlternativeJSON a b -> AlternativeJSON a b -> Ordering
AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON 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 (AlternativeJSON a b)
forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Ordering
forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON a b
min :: AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON a b
$cmin :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON a b
max :: AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON a b
$cmax :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> AlternativeJSON a b
>= :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
> :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
<= :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
< :: AlternativeJSON a b -> AlternativeJSON a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Bool
compare :: AlternativeJSON a b -> AlternativeJSON a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
AlternativeJSON a b -> AlternativeJSON a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (AlternativeJSON a b)
Ord, Int -> AlternativeJSON a b -> ShowS
[AlternativeJSON a b] -> ShowS
AlternativeJSON a b -> String
(Int -> AlternativeJSON a b -> ShowS)
-> (AlternativeJSON a b -> String)
-> ([AlternativeJSON a b] -> ShowS)
-> Show (AlternativeJSON a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> AlternativeJSON a b -> ShowS
forall a b. (Show a, Show b) => [AlternativeJSON a b] -> ShowS
forall a b. (Show a, Show b) => AlternativeJSON a b -> String
showList :: [AlternativeJSON a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [AlternativeJSON a b] -> ShowS
show :: AlternativeJSON a b -> String
$cshow :: forall a b. (Show a, Show b) => AlternativeJSON a b -> String
showsPrec :: Int -> AlternativeJSON a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> AlternativeJSON a b -> ShowS
Show)

instance (FromJSON a, FromJSON b) => FromJSON (AlternativeJSON a b) where
  parseJSON :: Value -> Parser (AlternativeJSON a b)
parseJSON Value
v = a -> AlternativeJSON a b
forall a b. a -> AlternativeJSON a b
FirstJSON (a -> AlternativeJSON a b)
-> Parser a -> Parser (AlternativeJSON a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser (AlternativeJSON a b)
-> Parser (AlternativeJSON a b) -> Parser (AlternativeJSON a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> AlternativeJSON a b
forall a b. b -> AlternativeJSON a b
SecondJSON (b -> AlternativeJSON a b)
-> Parser b -> Parser (AlternativeJSON a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | Handle either of the two types that have been parsed from JSON
alternative :: (a -> r) -> (b -> r) -> AlternativeJSON a b -> r
alternative :: (a -> r) -> (b -> r) -> AlternativeJSON a b -> r
alternative a -> r
f b -> r
_ (FirstJSON a
a) = a -> r
f a
a
alternative a -> r
_ b -> r
g (SecondJSON b
b) = b -> r
g b
b