-- |
-- Module      : CAS.Dumb.Util.These
-- Copyright   : (c) Justus Sagemüller 2017
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 

{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}

module CAS.Dumb.Util.These where

import qualified Data.Map as Map
import Data.Map (Map)

import GHC.Generics


data These a b = This a
               | That b
               | These a b
  deriving (forall a b. a -> These a b -> These a a
forall a b. (a -> b) -> These a a -> These a b
forall a a b. a -> These a b -> These a a
forall a a b. (a -> b) -> These a a -> These a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> These a b -> These a a
$c<$ :: forall a a b. a -> These a b -> These a a
fmap :: forall a b. (a -> b) -> These a a -> These a b
$cfmap :: forall a a b. (a -> b) -> These a a -> These a b
Functor, These a b -> These a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
/= :: These a b -> These a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
== :: These a b -> These a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (These a b) x -> These a b
forall a b x. These a b -> Rep (These a b) x
$cto :: forall a b x. Rep (These a b) x -> These a b
$cfrom :: forall a b x. These a b -> Rep (These a b) x
Generic)


traverseUnion :: (Applicative t, Ord k)
            => (These a b -> t c) -> Map k a -> Map k b -> t (Map k c)
traverseUnion :: forall (t :: * -> *) k a b c.
(Applicative t, Ord k) =>
(These a b -> t c) -> Map k a -> Map k b -> t (Map k c)
traverseUnion These a b -> t c
f Map k a
ma Map k b
mb = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse These a b -> t c
f forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\(This a
a) (That b
b) -> forall a b. a -> b -> These a b
These a
a b
b)
                                                   (forall a b. a -> These a b
Thisforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Map k a
ma) (forall a b. b -> These a b
Thatforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Map k b
mb)

traverseUnionConflicts :: (Applicative t, Ord k)
            => (a -> a -> t a) -> Map k a -> Map k a -> t (Map k a)
traverseUnionConflicts :: forall (t :: * -> *) k a.
(Applicative t, Ord k) =>
(a -> a -> t a) -> Map k a -> Map k a -> t (Map k a)
traverseUnionConflicts a -> a -> t a
f Map k a
ma Map k a
mb = forall (t :: * -> *) k a b c.
(Applicative t, Ord k) =>
(These a b -> t c) -> Map k a -> Map k b -> t (Map k c)
traverseUnion These a a -> t a
f' Map k a
ma Map k a
mb
 where f' :: These a a -> t a
f' (This a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
       f' (That a
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
       f' (These a
a a
b) = a -> a -> t a
f a
a a
b