{-# LANGUAGE TypeOperators #-}
-- | This module defines data type (a :|: b) that behaves all like @Either@,
-- except that has no tag in JSON representation as used by @FromJSON@ and @ToJSON@.
module JsonToType.Alternative(
    (:|:)(..)
  , toEither, fromEither
  , alt
  ) where

import Data.Aeson
import Control.Applicative

-- | Data type (a :|: b) that behaves all like @Either@,
-- except that has no tag in JSON representation as used by @FromJSON@ and @ToJSON@.
data a :|: b = AltLeft  a
             | AltRight b
  deriving(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)
infixr 5 :|:

-- | Convert to @Either@ datatype.
toEither :: a :|: b -> Either a b
toEither :: forall a b. (a :|: b) -> Either a b
toEither (AltLeft  a
a) = a -> Either a b
forall a b. a -> Either a b
Left  a
a
toEither (AltRight b
b) = b -> Either a b
forall a b. b -> Either a b
Right b
b
{-# INLINE toEither #-}

-- | Convert from @Either@ datatype.
fromEither :: Either a b -> a :|: b
fromEither :: forall a b. Either a b -> a :|: b
fromEither (Left  a
a) = a -> a :|: b
forall a b. a -> a :|: b
AltLeft  a
a
fromEither (Right b
b) = b -> a :|: b
forall a b. b -> a :|: b
AltRight b
b
{-# INLINE fromEither #-}

-- | Deconstruct the type with two functions corresponding to constructors.
-- This is like @either@.
alt :: (a -> c) -> (b -> c) -> a :|: b -> c
alt :: forall a c b. (a -> c) -> (b -> c) -> (a :|: b) -> c
alt a -> c
f b -> c
_ (AltLeft  a
a) = a -> c
f a
a
alt a -> c
_ b -> c
g (AltRight b
b) = b -> c
g b
b
infixr 5 `alt`

instance (ToJSON a, ToJSON b) => ToJSON (a :|: b) where
    toJSON :: (a :|: b) -> Value
toJSON (AltLeft  a
a) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a
    toJSON (AltRight b
b) = b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b
    {-# INLINE toJSON #-}

instance (FromJSON a, FromJSON b) => FromJSON (a :|: b) where
    parseJSON :: Value -> Parser (a :|: b)
parseJSON Value
input = (a -> a :|: b
forall a b. a -> a :|: b
AltLeft  (a -> a :|: b) -> Parser a -> Parser (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
input) Parser (a :|: b) -> Parser (a :|: b) -> Parser (a :|: b)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      (b -> a :|: b
forall a b. b -> a :|: b
AltRight (b -> a :|: b) -> Parser b -> Parser (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
input) Parser (a :|: b) -> Parser (a :|: b) -> Parser (a :|: b)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      String -> Parser (a :|: b)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Neither alternative was found for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
input)
    {-# INLINE parseJSON #-}