{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Aeson.Extra.Merge
-- Copyright   :  (C) 2015-2016 Oleg Grenrus
-- License     :  BSD3
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
module Data.Aeson.Extra.Merge (
    merge,
    mergeA,
    lodashMerge,
    ValueF(..),
    ObjectF,
    ArrayF,
    ) where

import Prelude ()
import Prelude.Compat

import Data.Aeson
import Data.Aeson.Extra.Recursive
import Data.Align                 (alignWith)
import Data.Functor.Foldable      (embed, project)
import Data.These                 (These (..))

-- | Generic merge.
--
-- For example see 'lodashMerge'.
--
-- /Since: aeson-extra-0.3.1.0/
merge :: (forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a)
       -> Value -> Value -> Value
merge :: (forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a)
-> Value -> Value -> Value
merge forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
f Value
a Value
b = Base Value Value -> Value
forall t. Corecursive t => Base t t -> t
embed (Base Value Value -> Value) -> Base Value Value -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Value)
-> ValueF Value -> ValueF Value -> ValueF Value
forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
f ((forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a)
-> Value -> Value -> Value
merge forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
f) (Value -> Base Value Value
forall t. Recursive t => t -> Base t t
project Value
a) (Value -> Base Value Value
forall t. Recursive t => t -> Base t t
project Value
b)

-- | Generic merge, in arbitrary context.
--
-- /Since: aeson-extra-0.3.1.0/
mergeA :: Functor f
      => (forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a))
      -> Value -> Value -> f Value
mergeA :: (forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a))
-> Value -> Value -> f Value
mergeA forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a)
f Value
a Value
b = ValueF Value -> Value
forall t. Corecursive t => Base t t -> t
embed (ValueF Value -> Value) -> f (ValueF Value) -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Value -> f Value)
-> ValueF Value -> ValueF Value -> f (ValueF Value)
forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a)
f ((forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a))
-> Value -> Value -> f Value
forall (f :: * -> *).
Functor f =>
(forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a))
-> Value -> Value -> f Value
mergeA forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a)
f) (Value -> Base Value Value
forall t. Recursive t => t -> Base t t
project Value
a) (Value -> Base Value Value
forall t. Recursive t => t -> Base t t
project Value
b)

-- | Example of using 'merge'. see <https://lodash.com/docs#merge>:
--
-- /Note:/ not tested against JavaScript lodash, so may disagree in the results.
--
-- @since 0.4.1.0
lodashMerge :: Value -> Value -> Value
lodashMerge :: Value -> Value -> Value
lodashMerge = (forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a)
-> Value -> Value -> Value
merge forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
alg
  where
    alg :: (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
    alg :: (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a
alg a -> a -> a
r ValueF a
a' ValueF a
b' = case (ValueF a
a', ValueF a
b') of
        (ObjectF ObjectF a
a, ObjectF ObjectF a
b) -> ObjectF a -> ValueF a
forall a. ObjectF a -> ValueF a
ObjectF (ObjectF a -> ValueF a) -> ObjectF a -> ValueF a
forall a b. (a -> b) -> a -> b
$ (These a a -> a) -> ObjectF a -> ObjectF a -> ObjectF a
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a a -> a
f ObjectF a
a ObjectF a
b
        (ArrayF ArrayF a
a,  ArrayF ArrayF a
b)  -> ArrayF a -> ValueF a
forall a. ArrayF a -> ValueF a
ArrayF (ArrayF a -> ValueF a) -> ArrayF a -> ValueF a
forall a b. (a -> b) -> a -> b
$ (These a a -> a) -> ArrayF a -> ArrayF a -> ArrayF a
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a a -> a
f ArrayF a
a ArrayF a
b
        (ValueF a
_,         ValueF a
b)         -> ValueF a
b
      where
        f :: These a a -> a
f (These a
x a
y) = a -> a -> a
r a
x a
y
        f (This a
x)    = a
x
        f (That a
x)    = a
x