--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Map.NonEmpty.Monoidal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A NonEmpty Monoidal Map, i.e. combining the monoidal maps combines the elements with
-- their semigroup operation.
--
--------------------------------------------------------------------------------
module HGeometry.Map.NonEmpty.Monoidal
  ( MonoidalNEMap(..)
  , singleton
  , unions1WithKey
  , mapWithKeyMerge1
  ) where

import           Data.Foldable1
import           Data.Map.NonEmpty (NEMap)
import qualified Data.Map.NonEmpty as NEMap

--------------------------------------------------------------------------------

-- | A NonEmpty Map in which we combine conflicting elements by using their semigroup
-- operation rather than picking the left value (as is done in the default Data.Map)
newtype MonoidalNEMap k v = MonoidalNEMap { forall k v. MonoidalNEMap k v -> NEMap k v
getNEMap :: NEMap k v }
  deriving stock (Int -> MonoidalNEMap k v -> ShowS
[MonoidalNEMap k v] -> ShowS
MonoidalNEMap k v -> String
(Int -> MonoidalNEMap k v -> ShowS)
-> (MonoidalNEMap k v -> String)
-> ([MonoidalNEMap k v] -> ShowS)
-> Show (MonoidalNEMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> MonoidalNEMap k v -> ShowS
forall k v. (Show k, Show v) => [MonoidalNEMap k v] -> ShowS
forall k v. (Show k, Show v) => MonoidalNEMap k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> MonoidalNEMap k v -> ShowS
showsPrec :: Int -> MonoidalNEMap k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => MonoidalNEMap k v -> String
show :: MonoidalNEMap k v -> String
$cshowList :: forall k v. (Show k, Show v) => [MonoidalNEMap k v] -> ShowS
showList :: [MonoidalNEMap k v] -> ShowS
Show)
  deriving newtype ((forall a b. (a -> b) -> MonoidalNEMap k a -> MonoidalNEMap k b)
-> (forall a b. a -> MonoidalNEMap k b -> MonoidalNEMap k a)
-> Functor (MonoidalNEMap k)
forall a b. a -> MonoidalNEMap k b -> MonoidalNEMap k a
forall a b. (a -> b) -> MonoidalNEMap k a -> MonoidalNEMap k b
forall k a b. a -> MonoidalNEMap k b -> MonoidalNEMap k a
forall k a b. (a -> b) -> MonoidalNEMap k a -> MonoidalNEMap k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> MonoidalNEMap k a -> MonoidalNEMap k b
fmap :: forall a b. (a -> b) -> MonoidalNEMap k a -> MonoidalNEMap k b
$c<$ :: forall k a b. a -> MonoidalNEMap k b -> MonoidalNEMap k a
<$ :: forall a b. a -> MonoidalNEMap k b -> MonoidalNEMap k a
Functor,(forall m. Monoid m => MonoidalNEMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b)
-> (forall a. (a -> a -> a) -> MonoidalNEMap k a -> a)
-> (forall a. (a -> a -> a) -> MonoidalNEMap k a -> a)
-> (forall a. MonoidalNEMap k a -> [a])
-> (forall a. MonoidalNEMap k a -> Bool)
-> (forall a. MonoidalNEMap k a -> Int)
-> (forall a. Eq a => a -> MonoidalNEMap k a -> Bool)
-> (forall a. Ord a => MonoidalNEMap k a -> a)
-> (forall a. Ord a => MonoidalNEMap k a -> a)
-> (forall a. Num a => MonoidalNEMap k a -> a)
-> (forall a. Num a => MonoidalNEMap k a -> a)
-> Foldable (MonoidalNEMap k)
forall a. Eq a => a -> MonoidalNEMap k a -> Bool
forall a. Num a => MonoidalNEMap k a -> a
forall a. Ord a => MonoidalNEMap k a -> a
forall m. Monoid m => MonoidalNEMap k m -> m
forall a. MonoidalNEMap k a -> Bool
forall a. MonoidalNEMap k a -> Int
forall a. MonoidalNEMap k a -> [a]
forall a. (a -> a -> a) -> MonoidalNEMap k a -> a
forall k a. Eq a => a -> MonoidalNEMap k a -> Bool
forall k a. Num a => MonoidalNEMap k a -> a
forall k a. Ord a => MonoidalNEMap k a -> a
forall k m. Monoid m => MonoidalNEMap k m -> m
forall m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
forall k a. MonoidalNEMap k a -> Bool
forall k a. MonoidalNEMap k a -> Int
forall k a. MonoidalNEMap k a -> [a]
forall b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
forall a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b
forall k a. (a -> a -> a) -> MonoidalNEMap k a -> a
forall k m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
forall k b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
forall k a b. (a -> b -> b) -> b -> MonoidalNEMap k 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
$cfold :: forall k m. Monoid m => MonoidalNEMap k m -> m
fold :: forall m. Monoid m => MonoidalNEMap k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MonoidalNEMap k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MonoidalNEMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MonoidalNEMap k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> MonoidalNEMap k a -> a
foldr1 :: forall a. (a -> a -> a) -> MonoidalNEMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> MonoidalNEMap k a -> a
foldl1 :: forall a. (a -> a -> a) -> MonoidalNEMap k a -> a
$ctoList :: forall k a. MonoidalNEMap k a -> [a]
toList :: forall a. MonoidalNEMap k a -> [a]
$cnull :: forall k a. MonoidalNEMap k a -> Bool
null :: forall a. MonoidalNEMap k a -> Bool
$clength :: forall k a. MonoidalNEMap k a -> Int
length :: forall a. MonoidalNEMap k a -> Int
$celem :: forall k a. Eq a => a -> MonoidalNEMap k a -> Bool
elem :: forall a. Eq a => a -> MonoidalNEMap k a -> Bool
$cmaximum :: forall k a. Ord a => MonoidalNEMap k a -> a
maximum :: forall a. Ord a => MonoidalNEMap k a -> a
$cminimum :: forall k a. Ord a => MonoidalNEMap k a -> a
minimum :: forall a. Ord a => MonoidalNEMap k a -> a
$csum :: forall k a. Num a => MonoidalNEMap k a -> a
sum :: forall a. Num a => MonoidalNEMap k a -> a
$cproduct :: forall k a. Num a => MonoidalNEMap k a -> a
product :: forall a. Num a => MonoidalNEMap k a -> a
Foldable,Foldable (MonoidalNEMap k)
Foldable (MonoidalNEMap k) =>
(forall m. Semigroup m => MonoidalNEMap k m -> m)
-> (forall m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m)
-> (forall m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m)
-> (forall a. MonoidalNEMap k a -> NonEmpty a)
-> (forall a. Ord a => MonoidalNEMap k a -> a)
-> (forall a. Ord a => MonoidalNEMap k a -> a)
-> (forall a. MonoidalNEMap k a -> a)
-> (forall a. MonoidalNEMap k a -> a)
-> (forall a b.
    (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b)
-> (forall a b.
    (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b)
-> (forall a b.
    (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b)
-> (forall a b.
    (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b)
-> Foldable1 (MonoidalNEMap k)
forall k. Foldable (MonoidalNEMap k)
forall a. Ord a => MonoidalNEMap k a -> a
forall m. Semigroup m => MonoidalNEMap k m -> m
forall a. MonoidalNEMap k a -> a
forall a. MonoidalNEMap k a -> NonEmpty a
forall k a. Ord a => MonoidalNEMap k a -> a
forall k m. Semigroup m => MonoidalNEMap k m -> m
forall m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
forall k a. MonoidalNEMap k a -> a
forall k a. MonoidalNEMap k a -> NonEmpty a
forall a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
forall a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
forall k m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
forall k a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
forall k a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
forall (t :: * -> *).
Foldable t =>
(forall m. Semigroup m => t m -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall m a. Semigroup m => (a -> m) -> t a -> m)
-> (forall a. t a -> NonEmpty a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. t a -> a)
-> (forall a. t a -> a)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (b -> a -> b) -> t a -> b)
-> (forall a b. (a -> b) -> (a -> b -> b) -> t a -> b)
-> Foldable1 t
$cfold1 :: forall k m. Semigroup m => MonoidalNEMap k m -> m
fold1 :: forall m. Semigroup m => MonoidalNEMap k m -> m
$cfoldMap1 :: forall k m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
foldMap1 :: forall m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
$cfoldMap1' :: forall k m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
foldMap1' :: forall m a. Semigroup m => (a -> m) -> MonoidalNEMap k a -> m
$ctoNonEmpty :: forall k a. MonoidalNEMap k a -> NonEmpty a
toNonEmpty :: forall a. MonoidalNEMap k a -> NonEmpty a
$cmaximum :: forall k a. Ord a => MonoidalNEMap k a -> a
maximum :: forall a. Ord a => MonoidalNEMap k a -> a
$cminimum :: forall k a. Ord a => MonoidalNEMap k a -> a
minimum :: forall a. Ord a => MonoidalNEMap k a -> a
$chead :: forall k a. MonoidalNEMap k a -> a
head :: forall a. MonoidalNEMap k a -> a
$clast :: forall k a. MonoidalNEMap k a -> a
last :: forall a. MonoidalNEMap k a -> a
$cfoldrMap1 :: forall k a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
$cfoldlMap1' :: forall k a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
$cfoldlMap1 :: forall k a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> MonoidalNEMap k a -> b
$cfoldrMap1' :: forall k a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
foldrMap1' :: forall a b. (a -> b) -> (a -> b -> b) -> MonoidalNEMap k a -> b
Foldable1)

instance (Ord k, Semigroup v) => Semigroup (MonoidalNEMap k v) where
  (MonoidalNEMap NEMap k v
ma) <> :: MonoidalNEMap k v -> MonoidalNEMap k v -> MonoidalNEMap k v
<> (MonoidalNEMap NEMap k v
mb) = NEMap k v -> MonoidalNEMap k v
forall k v. NEMap k v -> MonoidalNEMap k v
MonoidalNEMap (NEMap k v -> MonoidalNEMap k v) -> NEMap k v -> MonoidalNEMap k v
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> NEMap k v -> NEMap k v -> NEMap k v
forall k a.
Ord k =>
(a -> a -> a) -> NEMap k a -> NEMap k a -> NEMap k a
NEMap.unionWith v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>) NEMap k v
ma NEMap k v
mb

-- | Create a singleton MonoidalNE Map
singleton     :: k -> v -> MonoidalNEMap k v
singleton :: forall k v. k -> v -> MonoidalNEMap k v
singleton k
k v
v = NEMap k v -> MonoidalNEMap k v
forall k v. NEMap k v -> MonoidalNEMap k v
MonoidalNEMap (NEMap k v -> MonoidalNEMap k v) -> NEMap k v -> MonoidalNEMap k v
forall a b. (a -> b) -> a -> b
$ k -> v -> NEMap k v
forall k a. k -> a -> NEMap k a
NEMap.singleton k
k v
v

-- | Merge a bunch of non-empty maps with the given mergin function
unions1WithKey   :: (Foldable1 f, Ord k) => (k -> a-> a ->a) -> f (NEMap k a) -> NEMap k a
unions1WithKey :: forall (f :: * -> *) k a.
(Foldable1 f, Ord k) =>
(k -> a -> a -> a) -> f (NEMap k a) -> NEMap k a
unions1WithKey k -> a -> a -> a
f = (NEMap k a -> NEMap k a -> NEMap k a) -> f (NEMap k a) -> NEMap k a
forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1' ((k -> a -> a -> a) -> NEMap k a -> NEMap k a -> NEMap k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> NEMap k a -> NEMap k a -> NEMap k a
NEMap.unionWithKey k -> a -> a -> a
f)

-- | Merge the maps. When they share a key, combine their values using a semigroup.
mapWithKeyMerge1   :: (Ord k', Semigroup v')
                   => (k -> v -> NEMap k' v') -> NEMap k v -> NEMap k' v'
mapWithKeyMerge1 :: forall k' v' k v.
(Ord k', Semigroup v') =>
(k -> v -> NEMap k' v') -> NEMap k v -> NEMap k' v'
mapWithKeyMerge1 k -> v -> NEMap k' v'
f = MonoidalNEMap k' v' -> NEMap k' v'
forall k v. MonoidalNEMap k v -> NEMap k v
getNEMap (MonoidalNEMap k' v' -> NEMap k' v')
-> (NEMap k v -> MonoidalNEMap k' v') -> NEMap k v -> NEMap k' v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> v -> MonoidalNEMap k' v') -> NEMap k v -> MonoidalNEMap k' v'
forall m k a. Semigroup m => (k -> a -> m) -> NEMap k a -> m
NEMap.foldMapWithKey (\k
k v
v -> NEMap k' v' -> MonoidalNEMap k' v'
forall k v. NEMap k v -> MonoidalNEMap k v
MonoidalNEMap (NEMap k' v' -> MonoidalNEMap k' v')
-> NEMap k' v' -> MonoidalNEMap k' v'
forall a b. (a -> b) -> a -> b
$ k -> v -> NEMap k' v'
f k
k v
v)