-- |
-- Copyright: © 2022–2023 Jonathan Knowles
-- License: Apache-2.0
--
-- A lawful implementation of 'MultiMap', implemented in terms of 'Map' and
-- 'Set'.
--
module Examples.MultiMap.Instances.MultiMap2 where

import Prelude

import Data.Map.Strict
    ( Map )
import Data.Set
    ( Set )

import qualified Data.Map.Merge.Strict as Map
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Examples.MultiMap.Class as Class

newtype MultiMap k v = MultiMap (Map k (Set v))
    deriving stock (MultiMap k v -> MultiMap k v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => MultiMap k v -> MultiMap k v -> Bool
/= :: MultiMap k v -> MultiMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => MultiMap k v -> MultiMap k v -> Bool
== :: MultiMap k v -> MultiMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => MultiMap k v -> MultiMap k v -> Bool
Eq, Int -> MultiMap k v -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> MultiMap k v -> ShowS
forall k v. (Show k, Show v) => [MultiMap k v] -> ShowS
forall k v. (Show k, Show v) => MultiMap k v -> String
showList :: [MultiMap k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [MultiMap k v] -> ShowS
show :: MultiMap k v -> String
$cshow :: forall k v. (Show k, Show v) => MultiMap k v -> String
showsPrec :: Int -> MultiMap k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> MultiMap k v -> ShowS
Show)

instance (Ord k, Ord v) => Class.MultiMap MultiMap k v where

    fromList :: [(k, Set v)] -> MultiMap k v
fromList = forall k v. Map k (Set v) -> MultiMap k v
MultiMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

    toList :: MultiMap k v -> [(k, Set v)]
toList (MultiMap Map k (Set v)
m) = forall k a. Map k a -> [(k, a)]
Map.toList Map k (Set v)
m

    empty :: MultiMap k v
empty = forall k v. Map k (Set v) -> MultiMap k v
MultiMap forall k a. Map k a
Map.empty

    lookup :: k -> MultiMap k v -> Set v
lookup k
k (MultiMap Map k (Set v)
m) = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty k
k Map k (Set v)
m

    null :: MultiMap k v -> Bool
null (MultiMap Map k (Set v)
m) = forall k a. Map k a -> Bool
Map.null Map k (Set v)
m

    nonNull :: MultiMap k v -> Bool
nonNull (MultiMap Map k (Set v)
m) = Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map k (Set v)
m)

    nonNullKey :: k -> MultiMap k v -> Bool
nonNullKey k
k (MultiMap Map k (Set v)
m) = forall k a. Ord k => k -> Map k a -> Bool
Map.member k
k Map k (Set v)
m

    nonNullKeys :: MultiMap k v -> Set k
nonNullKeys (MultiMap Map k (Set v)
m) = forall k a. Map k a -> Set k
Map.keysSet Map k (Set v)
m

    nonNullCount :: MultiMap k v -> Int
nonNullCount (MultiMap Map k (Set v)
m) = forall k a. Map k a -> Int
Map.size Map k (Set v)
m

    isSubmapOf :: MultiMap k v -> MultiMap k v -> Bool
isSubmapOf (MultiMap Map k (Set v)
m1) (MultiMap Map k (Set v)
m2) =
        forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Map k (Set v)
m1 Map k (Set v)
m2

    update :: k -> Set v -> MultiMap k v -> MultiMap k v
update k
k Set v
vs (MultiMap Map k (Set v)
m)
        | forall a. Set a -> Bool
Set.null Set v
vs = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k    Map k (Set v)
m)
        | Bool
otherwise   = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k Set v
vs Map k (Set v)
m)

    insert :: k -> Set v -> MultiMap k v -> MultiMap k v
insert k
k Set v
vs (MultiMap Map k (Set v)
m)
        | forall a. Set a -> Bool
Set.null Set v
xs = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k    Map k (Set v)
m)
        | Bool
otherwise   = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k Set v
xs Map k (Set v)
m)
      where
        xs :: Set v
xs = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty k
k Map k (Set v)
m forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set v
vs

    remove :: k -> Set v -> MultiMap k v -> MultiMap k v
remove k
k Set v
vs (MultiMap Map k (Set v)
m)
        | forall a. Set a -> Bool
Set.null Set v
xs = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k    Map k (Set v)
m)
        | Bool
otherwise   = forall k v. Map k (Set v) -> MultiMap k v
MultiMap (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k Set v
xs Map k (Set v)
m)
      where
        xs :: Set v
xs = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty k
k Map k (Set v)
m forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set v
vs

    union :: MultiMap k v -> MultiMap k v -> MultiMap k v
union (MultiMap Map k (Set v)
m1) (MultiMap Map k (Set v)
m2) = forall k v. Map k (Set v) -> MultiMap k v
MultiMap 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 forall a. Ord a => Set a -> Set a -> Set a
Set.union Map k (Set v)
m1 Map k (Set v)
m2

    intersection :: MultiMap k v -> MultiMap k v -> MultiMap k v
intersection (MultiMap Map k (Set v)
m1) (MultiMap Map k (Set v)
m2) = forall k v. Map k (Set v) -> MultiMap k v
MultiMap forall a b. (a -> b) -> a -> b
$
        forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
            forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
            forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
            (forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched k -> Set v -> Set v -> Maybe (Set v)
mergeValues)
            Map k (Set v)
m1
            Map k (Set v)
m2
      where
        mergeValues :: k -> Set v -> Set v -> Maybe (Set v)
        mergeValues :: k -> Set v -> Set v -> Maybe (Set v)
mergeValues k
_k Set v
s1 Set v
s2
            | forall a. Set a -> Bool
Set.null Set v
s3 = forall a. Maybe a
Nothing
            | Bool
otherwise   = forall a. a -> Maybe a
Just Set v
s3
          where
            s3 :: Set v
s3 = forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set v
s1 Set v
s2