{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Aeson.Config.Types where

import           Data.Semigroup (Semigroup(..))
import           Data.Bitraversable
import           Data.Bifoldable
import           Data.Bifunctor

import           Data.Aeson.Config.FromValue

newtype List a = List {List a -> [a]
fromList :: [a]}
  deriving (List a -> List a -> Bool
(List a -> List a -> Bool)
-> (List a -> List a -> Bool) -> Eq (List a)
forall a. Eq a => List a -> List a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List a -> List a -> Bool
$c/= :: forall a. Eq a => List a -> List a -> Bool
== :: List a -> List a -> Bool
$c== :: forall a. Eq a => List a -> List a -> Bool
Eq, Int -> List a -> ShowS
[List a] -> ShowS
List a -> String
(Int -> List a -> ShowS)
-> (List a -> String) -> ([List a] -> ShowS) -> Show (List a)
forall a. Show a => Int -> List a -> ShowS
forall a. Show a => [List a] -> ShowS
forall a. Show a => List a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List a] -> ShowS
$cshowList :: forall a. Show a => [List a] -> ShowS
show :: List a -> String
$cshow :: forall a. Show a => List a -> String
showsPrec :: Int -> List a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> List a -> ShowS
Show, a -> List b -> List a
(a -> b) -> List a -> List b
(forall a b. (a -> b) -> List a -> List b)
-> (forall a b. a -> List b -> List a) -> Functor List
forall a b. a -> List b -> List a
forall a b. (a -> b) -> List a -> List b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> List b -> List a
$c<$ :: forall a b. a -> List b -> List a
fmap :: (a -> b) -> List a -> List b
$cfmap :: forall a b. (a -> b) -> List a -> List b
Functor, a -> List a -> Bool
List m -> m
List a -> [a]
List a -> Bool
List a -> Int
List a -> a
List a -> a
List a -> a
List a -> a
(a -> m) -> List a -> m
(a -> m) -> List a -> m
(a -> b -> b) -> b -> List a -> b
(a -> b -> b) -> b -> List a -> b
(b -> a -> b) -> b -> List a -> b
(b -> a -> b) -> b -> List a -> b
(a -> a -> a) -> List a -> a
(a -> a -> a) -> List a -> a
(forall m. Monoid m => List m -> m)
-> (forall m a. Monoid m => (a -> m) -> List a -> m)
-> (forall m a. Monoid m => (a -> m) -> List a -> m)
-> (forall a b. (a -> b -> b) -> b -> List a -> b)
-> (forall a b. (a -> b -> b) -> b -> List a -> b)
-> (forall b a. (b -> a -> b) -> b -> List a -> b)
-> (forall b a. (b -> a -> b) -> b -> List a -> b)
-> (forall a. (a -> a -> a) -> List a -> a)
-> (forall a. (a -> a -> a) -> List a -> a)
-> (forall a. List a -> [a])
-> (forall a. List a -> Bool)
-> (forall a. List a -> Int)
-> (forall a. Eq a => a -> List a -> Bool)
-> (forall a. Ord a => List a -> a)
-> (forall a. Ord a => List a -> a)
-> (forall a. Num a => List a -> a)
-> (forall a. Num a => List a -> a)
-> Foldable List
forall a. Eq a => a -> List a -> Bool
forall a. Num a => List a -> a
forall a. Ord a => List a -> a
forall m. Monoid m => List m -> m
forall a. List a -> Bool
forall a. List a -> Int
forall a. List a -> [a]
forall a. (a -> a -> a) -> List a -> a
forall m a. Monoid m => (a -> m) -> List a -> m
forall b a. (b -> a -> b) -> b -> List a -> b
forall a b. (a -> b -> b) -> b -> List a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: List a -> a
$cproduct :: forall a. Num a => List a -> a
sum :: List a -> a
$csum :: forall a. Num a => List a -> a
minimum :: List a -> a
$cminimum :: forall a. Ord a => List a -> a
maximum :: List a -> a
$cmaximum :: forall a. Ord a => List a -> a
elem :: a -> List a -> Bool
$celem :: forall a. Eq a => a -> List a -> Bool
length :: List a -> Int
$clength :: forall a. List a -> Int
null :: List a -> Bool
$cnull :: forall a. List a -> Bool
toList :: List a -> [a]
$ctoList :: forall a. List a -> [a]
foldl1 :: (a -> a -> a) -> List a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> List a -> a
foldr1 :: (a -> a -> a) -> List a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> List a -> a
foldl' :: (b -> a -> b) -> b -> List a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> List a -> b
foldl :: (b -> a -> b) -> b -> List a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> List a -> b
foldr' :: (a -> b -> b) -> b -> List a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> List a -> b
foldr :: (a -> b -> b) -> b -> List a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> List a -> b
foldMap' :: (a -> m) -> List a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> List a -> m
foldMap :: (a -> m) -> List a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> List a -> m
fold :: List m -> m
$cfold :: forall m. Monoid m => List m -> m
Foldable, Functor List
Foldable List
Functor List
-> Foldable List
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> List a -> f (List b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    List (f a) -> f (List a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> List a -> m (List b))
-> (forall (m :: * -> *) a. Monad m => List (m a) -> m (List a))
-> Traversable List
(a -> f b) -> List a -> f (List b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => List (m a) -> m (List a)
forall (f :: * -> *) a. Applicative f => List (f a) -> f (List a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> List a -> m (List b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
sequence :: List (m a) -> m (List a)
$csequence :: forall (m :: * -> *) a. Monad m => List (m a) -> m (List a)
mapM :: (a -> m b) -> List a -> m (List b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> List a -> m (List b)
sequenceA :: List (f a) -> f (List a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => List (f a) -> f (List a)
traverse :: (a -> f b) -> List a -> f (List b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
$cp2Traversable :: Foldable List
$cp1Traversable :: Functor List
Traversable, b -> List a -> List a
NonEmpty (List a) -> List a
List a -> List a -> List a
(List a -> List a -> List a)
-> (NonEmpty (List a) -> List a)
-> (forall b. Integral b => b -> List a -> List a)
-> Semigroup (List a)
forall b. Integral b => b -> List a -> List a
forall a. NonEmpty (List a) -> List a
forall a. List a -> List a -> List a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> List a -> List a
stimes :: b -> List a -> List a
$cstimes :: forall a b. Integral b => b -> List a -> List a
sconcat :: NonEmpty (List a) -> List a
$csconcat :: forall a. NonEmpty (List a) -> List a
<> :: List a -> List a -> List a
$c<> :: forall a. List a -> List a -> List a
Semigroup, Semigroup (List a)
List a
Semigroup (List a)
-> List a
-> (List a -> List a -> List a)
-> ([List a] -> List a)
-> Monoid (List a)
[List a] -> List a
List a -> List a -> List a
forall a. Semigroup (List a)
forall a. List a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [List a] -> List a
forall a. List a -> List a -> List a
mconcat :: [List a] -> List a
$cmconcat :: forall a. [List a] -> List a
mappend :: List a -> List a -> List a
$cmappend :: forall a. List a -> List a -> List a
mempty :: List a
$cmempty :: forall a. List a
$cp1Monoid :: forall a. Semigroup (List a)
Monoid)

instance FromValue a => FromValue (List a) where
  fromValue :: Value -> Parser (List a)
fromValue Value
v = [a] -> List a
forall a. [a] -> List a
List ([a] -> List a) -> Parser [a] -> Parser (List a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Value
v of
    Array Array
_ -> Value -> Parser [a]
forall a. FromValue a => Value -> Parser a
fromValue Value
v
    Value
_ -> a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [a]) -> Parser a -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromValue a => Value -> Parser a
fromValue Value
v

fromMaybeList :: Maybe (List a) -> [a]
fromMaybeList :: Maybe (List a) -> [a]
fromMaybeList = [a] -> (List a -> [a]) -> Maybe (List a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] List a -> [a]
forall a. List a -> [a]
fromList

data Product a b = Product a b
  deriving (Product a b -> Product a b -> Bool
(Product a b -> Product a b -> Bool)
-> (Product a b -> Product a b -> Bool) -> Eq (Product a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Product a b -> Product a b -> Bool
/= :: Product a b -> Product a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Product a b -> Product a b -> Bool
== :: Product a b -> Product a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Product a b -> Product a b -> Bool
Eq, Int -> Product a b -> ShowS
[Product a b] -> ShowS
Product a b -> String
(Int -> Product a b -> ShowS)
-> (Product a b -> String)
-> ([Product a b] -> ShowS)
-> Show (Product a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Product a b -> ShowS
forall a b. (Show a, Show b) => [Product a b] -> ShowS
forall a b. (Show a, Show b) => Product a b -> String
showList :: [Product a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Product a b] -> ShowS
show :: Product a b -> String
$cshow :: forall a b. (Show a, Show b) => Product a b -> String
showsPrec :: Int -> Product a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Product a b -> ShowS
Show, a -> Product a b -> Product a a
(a -> b) -> Product a a -> Product a b
(forall a b. (a -> b) -> Product a a -> Product a b)
-> (forall a b. a -> Product a b -> Product a a)
-> Functor (Product a)
forall a b. a -> Product a b -> Product a a
forall a b. (a -> b) -> Product a a -> Product a b
forall a a b. a -> Product a b -> Product a a
forall a a b. (a -> b) -> Product a a -> Product a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Product a b -> Product a a
$c<$ :: forall a a b. a -> Product a b -> Product a a
fmap :: (a -> b) -> Product a a -> Product a b
$cfmap :: forall a a b. (a -> b) -> Product a a -> Product a b
Functor, Product a a -> Bool
(a -> m) -> Product a a -> m
(a -> b -> b) -> b -> Product a a -> b
(forall m. Monoid m => Product a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Product a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Product a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Product a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Product a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Product a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Product a a -> b)
-> (forall a. (a -> a -> a) -> Product a a -> a)
-> (forall a. (a -> a -> a) -> Product a a -> a)
-> (forall a. Product a a -> [a])
-> (forall a. Product a a -> Bool)
-> (forall a. Product a a -> Int)
-> (forall a. Eq a => a -> Product a a -> Bool)
-> (forall a. Ord a => Product a a -> a)
-> (forall a. Ord a => Product a a -> a)
-> (forall a. Num a => Product a a -> a)
-> (forall a. Num a => Product a a -> a)
-> Foldable (Product a)
forall a. Eq a => a -> Product a a -> Bool
forall a. Num a => Product a a -> a
forall a. Ord a => Product a a -> a
forall m. Monoid m => Product a m -> m
forall a. Product a a -> Bool
forall a. Product a a -> Int
forall a. Product a a -> [a]
forall a. (a -> a -> a) -> Product a a -> a
forall a a. Eq a => a -> Product a a -> Bool
forall a a. Num a => Product a a -> a
forall a a. Ord a => Product a a -> a
forall m a. Monoid m => (a -> m) -> Product a a -> m
forall a m. Monoid m => Product a m -> m
forall a a. Product a a -> Bool
forall a a. Product a a -> Int
forall a a. Product a a -> [a]
forall b a. (b -> a -> b) -> b -> Product a a -> b
forall a b. (a -> b -> b) -> b -> Product a a -> b
forall a a. (a -> a -> a) -> Product a a -> a
forall a m a. Monoid m => (a -> m) -> Product a a -> m
forall a b a. (b -> a -> b) -> b -> Product a a -> b
forall a a b. (a -> b -> b) -> b -> Product a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Product a a -> a
$cproduct :: forall a a. Num a => Product a a -> a
sum :: Product a a -> a
$csum :: forall a a. Num a => Product a a -> a
minimum :: Product a a -> a
$cminimum :: forall a a. Ord a => Product a a -> a
maximum :: Product a a -> a
$cmaximum :: forall a a. Ord a => Product a a -> a
elem :: a -> Product a a -> Bool
$celem :: forall a a. Eq a => a -> Product a a -> Bool
length :: Product a a -> Int
$clength :: forall a a. Product a a -> Int
null :: Product a a -> Bool
$cnull :: forall a a. Product a a -> Bool
toList :: Product a a -> [a]
$ctoList :: forall a a. Product a a -> [a]
foldl1 :: (a -> a -> a) -> Product a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> Product a a -> a
foldr1 :: (a -> a -> a) -> Product a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> Product a a -> a
foldl' :: (b -> a -> b) -> b -> Product a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> Product a a -> b
foldl :: (b -> a -> b) -> b -> Product a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> Product a a -> b
foldr' :: (a -> b -> b) -> b -> Product a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> Product a a -> b
foldr :: (a -> b -> b) -> b -> Product a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> Product a a -> b
foldMap' :: (a -> m) -> Product a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> Product a a -> m
foldMap :: (a -> m) -> Product a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> Product a a -> m
fold :: Product a m -> m
$cfold :: forall a m. Monoid m => Product a m -> m
Foldable, Functor (Product a)
Foldable (Product a)
Functor (Product a)
-> Foldable (Product a)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Product a a -> f (Product a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Product a (f a) -> f (Product a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Product a a -> m (Product a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Product a (m a) -> m (Product a a))
-> Traversable (Product a)
(a -> f b) -> Product a a -> f (Product a b)
forall a. Functor (Product a)
forall a. Foldable (Product a)
forall a (m :: * -> *) a.
Monad m =>
Product a (m a) -> m (Product a a)
forall a (f :: * -> *) a.
Applicative f =>
Product a (f a) -> f (Product a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Product a a -> m (Product a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Product a a -> f (Product a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Product a (m a) -> m (Product a a)
forall (f :: * -> *) a.
Applicative f =>
Product a (f a) -> f (Product a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Product a a -> m (Product a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Product a a -> f (Product a b)
sequence :: Product a (m a) -> m (Product a a)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
Product a (m a) -> m (Product a a)
mapM :: (a -> m b) -> Product a a -> m (Product a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Product a a -> m (Product a b)
sequenceA :: Product a (f a) -> f (Product a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
Product a (f a) -> f (Product a a)
traverse :: (a -> f b) -> Product a a -> f (Product a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Product a a -> f (Product a b)
$cp2Traversable :: forall a. Foldable (Product a)
$cp1Traversable :: forall a. Functor (Product a)
Traversable)

instance (Semigroup a, Semigroup b, Monoid a, Monoid b) => Monoid (Product a b) where
  mempty :: Product a b
mempty = a -> b -> Product a b
forall a b. a -> b -> Product a b
Product a
forall a. Monoid a => a
mempty b
forall a. Monoid a => a
mempty
  mappend :: Product a b -> Product a b -> Product a b
mappend = Product a b -> Product a b -> Product a b
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup a, Semigroup b) => Semigroup (Product a b) where
  Product a
a1 b
b1 <> :: Product a b -> Product a b -> Product a b
<> Product a
a2 b
b2 = a -> b -> Product a b
forall a b. a -> b -> Product a b
Product (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a2) (b
b1 b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b2)

instance Bifunctor Product where
  bimap :: (a -> b) -> (c -> d) -> Product a c -> Product b d
bimap a -> b
fa c -> d
fb (Product a
a c
b) = b -> d -> Product b d
forall a b. a -> b -> Product a b
Product (a -> b
fa a
a) (c -> d
fb c
b)

instance Bifoldable Product where
  bifoldMap :: (a -> m) -> (b -> m) -> Product a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Product a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

instance Bitraversable Product where
  bitraverse :: (a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
bitraverse a -> f c
fa b -> f d
fb (Product a
a b
b) = c -> d -> Product c d
forall a b. a -> b -> Product a b
Product (c -> d -> Product c d) -> f c -> f (d -> Product c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
fa a
a f (d -> Product c d) -> f d -> f (Product c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
fb b
b

instance (FromValue a, FromValue b) => FromValue (Product a b) where
  fromValue :: Value -> Parser (Product a b)
fromValue Value
v = a -> b -> Product a b
forall a b. a -> b -> Product a b
Product (a -> b -> Product a b) -> Parser a -> Parser (b -> Product a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromValue a => Value -> Parser a
fromValue Value
v Parser (b -> Product a b) -> Parser b -> Parser (Product a b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser b
forall a. FromValue a => Value -> Parser a
fromValue Value
v