{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Mergeable.Internal.Merge
( mergeConcat,
Merge (..),
mergeNoDuplicates,
recursiveMerge,
collect,
throwErrors,
)
where
import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Lazy as HM
import Data.Mergeable.Internal.NameCollision (NameCollision (nameCollision))
import Data.Mergeable.Internal.Resolution
( fromListT,
resolveWith,
runResolutionT,
)
import Relude hiding (empty, join)
class Merge m a where
merge :: (Monad m) => a -> a -> m a
instance
( Eq k,
Hashable k,
MonadError e m,
NameCollision e a
) =>
Merge m (HashMap k a)
where
merge :: Monad m => HashMap k a -> HashMap k a -> m (HashMap k a)
merge HashMap k a
x HashMap k a
y = forall k (m :: * -> *) e a b.
(Eq k, Hashable k, Monad m, MonadError e m, NameCollision e a) =>
([(k, a)] -> b) -> [(k, a)] -> m b
mergeNoDuplicates forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap k a
x forall a. Semigroup a => a -> a -> a
<> forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap k a
y)
mergeConcat ::
( Monad m,
Merge m a,
MonadError e m
) =>
NonEmpty a ->
m a
mergeConcat :: forall (m :: * -> *) a e.
(Monad m, Merge m a, MonadError e m) =>
NonEmpty a -> m a
mergeConcat (a
value :| []) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
mergeConcat (a
value :| (a
x : [a]
xs)) = do
a
a <- forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge a
value a
x
forall (m :: * -> *) a e.
(Monad m, Merge m a, MonadError e m) =>
NonEmpty a -> m a
mergeConcat (a
a forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
throwErrors :: MonadError e m => NonEmpty e -> m b
throwErrors :: forall e (m :: * -> *) b. MonadError e m => NonEmpty e -> m b
throwErrors (e
e :| [e]
es) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [e]
es
failOnDuplicates :: (MonadError e m, NameCollision e a) => NonEmpty a -> m a
failOnDuplicates :: forall e (m :: * -> *) a.
(MonadError e m, NameCollision e a) =>
NonEmpty a -> m a
failOnDuplicates (a
x :| [a]
xs)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
| Bool
otherwise = forall e (m :: * -> *) b. MonadError e m => NonEmpty e -> m b
throwErrors (forall e a. NameCollision e a => a -> e
nameCollision forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
mergeOnDuplicates ::
( Monad m,
Eq a,
Merge m a
) =>
a ->
a ->
m a
mergeOnDuplicates :: forall (m :: * -> *) a. (Monad m, Eq a, Merge m a) => a -> a -> m a
mergeOnDuplicates a
oldValue a
newValue
| a
oldValue forall a. Eq a => a -> a -> Bool
== a
newValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
oldValue
| Bool
otherwise = forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge a
oldValue a
newValue
mergeNoDuplicates ::
( Eq k,
Hashable k,
Monad m,
MonadError e m,
NameCollision e a
) =>
([(k, a)] -> b) ->
[(k, a)] ->
m b
mergeNoDuplicates :: forall k (m :: * -> *) e a b.
(Eq k, Hashable k, Monad m, MonadError e m, NameCollision e a) =>
([(k, a)] -> b) -> [(k, a)] -> m b
mergeNoDuplicates [(k, a)] -> b
f [(k, a)]
xs = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall (m :: * -> *) k a coll.
(Monad m, Eq k, Hashable k) =>
[(k, a)] -> ResolutionT k a coll m coll
fromListT [(k, a)]
xs) [(k, a)] -> b
f forall e (m :: * -> *) a.
(MonadError e m, NameCollision e a) =>
NonEmpty a -> m a
failOnDuplicates
recursiveMerge ::
( Eq k,
Eq a,
Hashable k,
Monad m,
Merge m a
) =>
([(k, a)] -> b) ->
[(k, a)] ->
m b
recursiveMerge :: forall k a (m :: * -> *) b.
(Eq k, Eq a, Hashable k, Monad m, Merge m a) =>
([(k, a)] -> b) -> [(k, a)] -> m b
recursiveMerge [(k, a)] -> b
f [(k, a)]
xs = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall (m :: * -> *) k a coll.
(Monad m, Eq k, Hashable k) =>
[(k, a)] -> ResolutionT k a coll m coll
fromListT [(k, a)]
xs) [(k, a)] -> b
f (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith forall (m :: * -> *) a. (Monad m, Eq a, Merge m a) => a -> a -> m a
mergeOnDuplicates)
collect ::
( Eq k,
Hashable k,
Monad m,
Semigroup v
) =>
[(k, v)] ->
m (HashMap k v)
collect :: forall k (m :: * -> *) v.
(Eq k, Hashable k, Monad m, Semigroup v) =>
[(k, v)] -> m (HashMap k v)
collect [(k, v)]
xs = forall k a coll (m :: * -> *) b.
ResolutionT k a coll m b
-> ([(k, a)] -> coll) -> (NonEmpty a -> m a) -> m b
runResolutionT (forall (m :: * -> *) k a coll.
(Monad m, Eq k, Hashable k) =>
[(k, a)] -> ResolutionT k a coll m coll
fromListT [(k, v)]
xs) forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList (forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> NonEmpty a -> m a
resolveWith (\v
x v
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (v
x forall a. Semigroup a => a -> a -> a
<> v
y)))