-- | This module contains a newtype wrapper around 'Data.Map.Map' that has a
-- correct 'Group' instance compared to the one for
-- 'Data.Map.Monoidal.MonoidalMap', in that it has a unique neutral element.
-- This comes with different constraints on the parameters (check the instances
-- for 'Semigroup' and 'Monoid' of the corresponding data structures if you're
-- interested).
--
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE UndecidableInstances #-} -- For (DecidablyEmpty (QueryResult q), Ord k, Query q) => Query (MonoidMap k q)
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DataKinds #-}
module Data.MonoidMap where

import Data.Semigroup.Commutative
import Data.Map.Monoidal (MonoidalMap)
import qualified Data.Map.Monoidal as Map
import Reflex (Query, QueryResult, crop, Group(..))
import Data.Monoid.DecidablyEmpty
import GHC.TypeLits
import Witherable

-- | Newtype wrapper around Data.Map.Monoidal.MonoidalMap
newtype MonoidMap k v = MonoidMap { forall k v. MonoidMap k v -> MonoidalMap k v
unMonoidMap :: MonoidalMap k v }
  deriving (Int -> MonoidMap k v -> ShowS
[MonoidMap k v] -> ShowS
MonoidMap k v -> String
(Int -> MonoidMap k v -> ShowS)
-> (MonoidMap k v -> String)
-> ([MonoidMap k v] -> ShowS)
-> Show (MonoidMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> MonoidMap k v -> ShowS
forall k v. (Show k, Show v) => [MonoidMap k v] -> ShowS
forall k v. (Show k, Show v) => MonoidMap k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> MonoidMap k v -> ShowS
showsPrec :: Int -> MonoidMap k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => MonoidMap k v -> String
show :: MonoidMap k v -> String
$cshowList :: forall k v. (Show k, Show v) => [MonoidMap k v] -> ShowS
showList :: [MonoidMap k v] -> ShowS
Show, MonoidMap k v -> MonoidMap k v -> Bool
(MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool) -> Eq (MonoidMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
== :: MonoidMap k v -> MonoidMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => MonoidMap k v -> MonoidMap k v -> Bool
/= :: MonoidMap k v -> MonoidMap k v -> Bool
Eq, Eq (MonoidMap k v)
Eq (MonoidMap k v) =>
(MonoidMap k v -> MonoidMap k v -> Ordering)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> Bool)
-> (MonoidMap k v -> MonoidMap k v -> MonoidMap k v)
-> (MonoidMap k v -> MonoidMap k v -> MonoidMap k v)
-> Ord (MonoidMap k v)
MonoidMap k v -> MonoidMap k v -> Bool
MonoidMap k v -> MonoidMap k v -> Ordering
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord k, Ord v) => Eq (MonoidMap k v)
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Ordering
forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
$ccompare :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Ordering
compare :: MonoidMap k v -> MonoidMap k v -> Ordering
$c< :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
< :: MonoidMap k v -> MonoidMap k v -> Bool
$c<= :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
<= :: MonoidMap k v -> MonoidMap k v -> Bool
$c> :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
> :: MonoidMap k v -> MonoidMap k v -> Bool
$c>= :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> Bool
>= :: MonoidMap k v -> MonoidMap k v -> Bool
$cmax :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
max :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
$cmin :: forall k v.
(Ord k, Ord v) =>
MonoidMap k v -> MonoidMap k v -> MonoidMap k v
min :: MonoidMap k v -> MonoidMap k v -> MonoidMap k v
Ord, (forall m. Monoid m => MonoidMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. (a -> a -> a) -> MonoidMap k a -> a)
-> (forall a. MonoidMap k a -> [a])
-> (forall a. MonoidMap k a -> Bool)
-> (forall a. MonoidMap k a -> Int)
-> (forall a. Eq a => a -> MonoidMap k a -> Bool)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Ord a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> (forall a. Num a => MonoidMap k a -> a)
-> Foldable (MonoidMap k)
forall a. Eq a => a -> MonoidMap k a -> Bool
forall a. Num a => MonoidMap k a -> a
forall a. Ord a => MonoidMap k a -> a
forall m. Monoid m => MonoidMap k m -> m
forall a. MonoidMap k a -> Bool
forall a. MonoidMap k a -> Int
forall a. MonoidMap k a -> [a]
forall a. (a -> a -> a) -> MonoidMap k a -> a
forall k a. Eq a => a -> MonoidMap k a -> Bool
forall k a. Num a => MonoidMap k a -> a
forall k a. Ord a => MonoidMap k a -> a
forall k m. Monoid m => MonoidMap k m -> m
forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k a. MonoidMap k a -> Bool
forall k a. MonoidMap k a -> Int
forall k a. MonoidMap k a -> [a]
forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
forall k a. (a -> a -> a) -> MonoidMap k a -> a
forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
forall k a b. (a -> b -> b) -> b -> MonoidMap 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 => MonoidMap k m -> m
fold :: forall m. Monoid m => MonoidMap k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> MonoidMap k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MonoidMap k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> MonoidMap k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MonoidMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> MonoidMap k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MonoidMap k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldr1 :: forall a. (a -> a -> a) -> MonoidMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> MonoidMap k a -> a
foldl1 :: forall a. (a -> a -> a) -> MonoidMap k a -> a
$ctoList :: forall k a. MonoidMap k a -> [a]
toList :: forall a. MonoidMap k a -> [a]
$cnull :: forall k a. MonoidMap k a -> Bool
null :: forall a. MonoidMap k a -> Bool
$clength :: forall k a. MonoidMap k a -> Int
length :: forall a. MonoidMap k a -> Int
$celem :: forall k a. Eq a => a -> MonoidMap k a -> Bool
elem :: forall a. Eq a => a -> MonoidMap k a -> Bool
$cmaximum :: forall k a. Ord a => MonoidMap k a -> a
maximum :: forall a. Ord a => MonoidMap k a -> a
$cminimum :: forall k a. Ord a => MonoidMap k a -> a
minimum :: forall a. Ord a => MonoidMap k a -> a
$csum :: forall k a. Num a => MonoidMap k a -> a
sum :: forall a. Num a => MonoidMap k a -> a
$cproduct :: forall k a. Num a => MonoidMap k a -> a
product :: forall a. Num a => MonoidMap k a -> a
Foldable)

instance TypeError (Text "Use mapMonoidMap instead of fmap; MonoidMap is not a Functor because mempty values would need to be deleted, and Functors cannot change the shape of a datastructure") => Functor (MonoidMap k) where
  fmap :: forall a b. (a -> b) -> MonoidMap k a -> MonoidMap k b
fmap = String -> (a -> b) -> MonoidMap k a -> MonoidMap k b
forall a. HasCallStack => String -> a
error String
"Impossible"

emptyToNothing :: DecidablyEmpty a => a -> Maybe a
emptyToNothing :: forall a. DecidablyEmpty a => a -> Maybe a
emptyToNothing a
a = if a -> Bool
forall a. DecidablyEmpty a => a -> Bool
isEmpty a
a then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
a

mapMonoidMap :: DecidablyEmpty b => (a -> b) -> MonoidMap k a -> MonoidMap k b
mapMonoidMap :: forall b a k.
DecidablyEmpty b =>
(a -> b) -> MonoidMap k a -> MonoidMap k b
mapMonoidMap a -> b
f (MonoidMap MonoidalMap k a
a) = MonoidalMap k b -> MonoidMap k b
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap (MonoidalMap k b -> MonoidMap k b)
-> MonoidalMap k b -> MonoidMap k b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> MonoidalMap k a -> MonoidalMap k b
forall a b. (a -> Maybe b) -> MonoidalMap k a -> MonoidalMap k b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (b -> Maybe b
forall a. DecidablyEmpty a => a -> Maybe a
emptyToNothing (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) MonoidalMap k a
a

traverseMonoidMap :: (Ord k, DecidablyEmpty b, Applicative f) => (a -> f b) -> MonoidMap k a -> f (MonoidMap k b)
traverseMonoidMap :: forall k b (f :: * -> *) a.
(Ord k, DecidablyEmpty b, Applicative f) =>
(a -> f b) -> MonoidMap k a -> f (MonoidMap k b)
traverseMonoidMap a -> f b
f (MonoidMap MonoidalMap k a
a) = MonoidalMap k b -> MonoidMap k b
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap (MonoidalMap k b -> MonoidMap k b)
-> f (MonoidalMap k b) -> f (MonoidMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f (Maybe b)) -> MonoidalMap k a -> f (MonoidalMap k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> MonoidalMap k a -> f (MonoidalMap k b)
wither ((b -> Maybe b) -> f b -> f (Maybe b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. DecidablyEmpty a => a -> Maybe a
emptyToNothing (f b -> f (Maybe b)) -> (a -> f b) -> a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) MonoidalMap k a
a

instance (Ord k, DecidablyEmpty v) => DecidablyEmpty (MonoidMap k v) where
  isEmpty :: MonoidMap k v -> Bool
isEmpty (MonoidMap MonoidalMap k v
m) = MonoidalMap k v -> Bool
forall k a. MonoidalMap k a -> Bool
Map.null MonoidalMap k v
m

-- | Convert a MonoidalMap into a MonoidMap
monoidMap :: (Ord k, DecidablyEmpty v) => MonoidalMap k v -> MonoidMap k v
monoidMap :: forall k v.
(Ord k, DecidablyEmpty v) =>
MonoidalMap k v -> MonoidMap k v
monoidMap = MonoidalMap k v -> MonoidMap k v
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap (MonoidalMap k v -> MonoidMap k v)
-> (MonoidalMap k v -> MonoidalMap k v)
-> MonoidalMap k v
-> MonoidMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Bool) -> MonoidalMap k v -> MonoidalMap k v
forall k a. (a -> Bool) -> MonoidalMap k a -> MonoidalMap k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (v -> Bool) -> v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Bool
forall a. DecidablyEmpty a => a -> Bool
isEmpty)

instance (DecidablyEmpty (QueryResult q), Ord k, Query q) => Query (MonoidMap k q) where
  type QueryResult (MonoidMap k q) = MonoidMap k (QueryResult q)
  crop :: MonoidMap k q
-> QueryResult (MonoidMap k q) -> QueryResult (MonoidMap k q)
crop (MonoidMap MonoidalMap k q
q) (MonoidMap MonoidalMap k (QueryResult q)
qr) =
    -- This assumes that the query result of a null query should be null
    MonoidalMap k (QueryResult q) -> MonoidMap k (QueryResult q)
forall k v.
(Ord k, DecidablyEmpty v) =>
MonoidalMap k v -> MonoidMap k v
monoidMap (MonoidalMap k (QueryResult q) -> MonoidMap k (QueryResult q))
-> MonoidalMap k (QueryResult q) -> MonoidMap k (QueryResult q)
forall a b. (a -> b) -> a -> b
$ (q -> QueryResult q -> QueryResult q)
-> MonoidalMap k q
-> MonoidalMap k (QueryResult q)
-> MonoidalMap k (QueryResult q)
forall k a b c.
Ord k =>
(a -> b -> c)
-> MonoidalMap k a -> MonoidalMap k b -> MonoidalMap k c
Map.intersectionWith q -> QueryResult q -> QueryResult q
forall a. Query a => a -> QueryResult a -> QueryResult a
crop MonoidalMap k q
q MonoidalMap k (QueryResult q)
qr

instance (Monoid a, DecidablyEmpty a, Ord k) => Semigroup (MonoidMap k a) where
  MonoidMap MonoidalMap k a
a <> :: MonoidMap k a -> MonoidMap k a -> MonoidMap k a
<> MonoidMap MonoidalMap k a
b =
    let combine :: p -> a -> a -> Maybe a
combine p
_ a
a' a
b' =
          let c :: a
c = a
a' a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
b'
          in if a -> Bool
forall a. DecidablyEmpty a => a -> Bool
isEmpty a
c
               then Maybe a
forall a. Maybe a
Nothing
               else a -> Maybe a
forall a. a -> Maybe a
Just a
c
    in MonoidalMap k a -> MonoidMap k a
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap (MonoidalMap k a -> MonoidMap k a)
-> MonoidalMap k a -> MonoidMap k a
forall a b. (a -> b) -> a -> b
$ (k -> a -> a -> Maybe a)
-> (MonoidalMap k a -> MonoidalMap k a)
-> (MonoidalMap k a -> MonoidalMap k a)
-> MonoidalMap k a
-> MonoidalMap k a
-> MonoidalMap k a
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (MonoidalMap k a -> MonoidalMap k c)
-> (MonoidalMap k b -> MonoidalMap k c)
-> MonoidalMap k a
-> MonoidalMap k b
-> MonoidalMap k c
Map.mergeWithKey k -> a -> a -> Maybe a
forall {a} {p}. DecidablyEmpty a => p -> a -> a -> Maybe a
combine MonoidalMap k a -> MonoidalMap k a
forall a. a -> a
id MonoidalMap k a -> MonoidalMap k a
forall a. a -> a
id MonoidalMap k a
a MonoidalMap k a
b

instance (Ord k, DecidablyEmpty a) => Monoid (MonoidMap k a) where
  mempty :: MonoidMap k a
mempty = MonoidalMap k a -> MonoidMap k a
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap MonoidalMap k a
forall k a. MonoidalMap k a
Map.empty
  mappend :: MonoidMap k a -> MonoidMap k a -> MonoidMap k a
mappend = MonoidMap k a -> MonoidMap k a -> MonoidMap k a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Ord k, DecidablyEmpty a, Group a) => Group (MonoidMap k a) where
  negateG :: MonoidMap k a -> MonoidMap k a
negateG (MonoidMap MonoidalMap k a
a) = MonoidalMap k a -> MonoidMap k a
forall k v. MonoidalMap k v -> MonoidMap k v
MonoidMap (MonoidalMap k a -> MonoidMap k a)
-> MonoidalMap k a -> MonoidMap k a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> MonoidalMap k a -> MonoidalMap k a
forall a b. (a -> b) -> MonoidalMap k a -> MonoidalMap k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall q. Group q => q -> q
negateG MonoidalMap k a
a

instance (Ord k, DecidablyEmpty a, Group a, Commutative a) => Commutative (MonoidMap k a)