{-# OPTIONS_GHC -Wunused-imports #-}
module Agda.Utils.Bag where
import Prelude hiding (null, map)
import Text.Show.Functions ()
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Semigroup
import Agda.Utils.Functor
import Agda.Utils.Impossible
newtype Bag a = Bag
{ forall a. Bag a -> Map a [a]
bag :: Map a [a]
}
deriving (Bag a -> Bag a -> Bool
(Bag a -> Bag a -> Bool) -> (Bag a -> Bag a -> Bool) -> Eq (Bag a)
forall a. Eq a => Bag a -> Bag a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Bag a -> Bag a -> Bool
== :: Bag a -> Bag a -> Bool
$c/= :: forall a. Eq a => Bag a -> Bag a -> Bool
/= :: Bag a -> Bag a -> Bool
Eq, Eq (Bag a)
Eq (Bag a) =>
(Bag a -> Bag a -> Ordering)
-> (Bag a -> Bag a -> Bool)
-> (Bag a -> Bag a -> Bool)
-> (Bag a -> Bag a -> Bool)
-> (Bag a -> Bag a -> Bool)
-> (Bag a -> Bag a -> Bag a)
-> (Bag a -> Bag a -> Bag a)
-> Ord (Bag a)
Bag a -> Bag a -> Bool
Bag a -> Bag a -> Ordering
Bag a -> Bag a -> Bag a
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 a. Ord a => Eq (Bag a)
forall a. Ord a => Bag a -> Bag a -> Bool
forall a. Ord a => Bag a -> Bag a -> Ordering
forall a. Ord a => Bag a -> Bag a -> Bag a
$ccompare :: forall a. Ord a => Bag a -> Bag a -> Ordering
compare :: Bag a -> Bag a -> Ordering
$c< :: forall a. Ord a => Bag a -> Bag a -> Bool
< :: Bag a -> Bag a -> Bool
$c<= :: forall a. Ord a => Bag a -> Bag a -> Bool
<= :: Bag a -> Bag a -> Bool
$c> :: forall a. Ord a => Bag a -> Bag a -> Bool
> :: Bag a -> Bag a -> Bool
$c>= :: forall a. Ord a => Bag a -> Bag a -> Bool
>= :: Bag a -> Bag a -> Bool
$cmax :: forall a. Ord a => Bag a -> Bag a -> Bag a
max :: Bag a -> Bag a -> Bag a
$cmin :: forall a. Ord a => Bag a -> Bag a -> Bag a
min :: Bag a -> Bag a -> Bag a
Ord)
null :: Bag a -> Bool
null :: forall a. Bag a -> Bool
null = Map a [a] -> Bool
forall k a. Map k a -> Bool
Map.null (Map a [a] -> Bool) -> (Bag a -> Map a [a]) -> Bag a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
size :: Bag a -> Int
size :: forall a. Bag a -> Int
size = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> (Bag a -> Sum Int) -> Bag a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Sum Int) -> Map a [a] -> Sum Int
forall m a. Monoid m => (a -> m) -> Map a a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> ([a] -> Int) -> [a] -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (Map a [a] -> Sum Int) -> (Bag a -> Map a [a]) -> Bag a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
(!) :: Ord a => Bag a -> a -> [a]
! :: forall a. Ord a => Bag a -> a -> [a]
(!) (Bag Map a [a]
b) a
a = [a] -> a -> Map a [a] -> [a]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] a
a Map a [a]
b
member :: Ord a => a -> Bag a -> Bool
member :: forall a. Ord a => a -> Bag a -> Bool
member a
a = Bool -> Bool
not (Bool -> Bool) -> (Bag a -> Bool) -> Bag a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bag a -> Bool
forall a. Ord a => a -> Bag a -> Bool
notMember a
a
notMember :: Ord a => a -> Bag a -> Bool
notMember :: forall a. Ord a => a -> Bag a -> Bool
notMember a
a Bag a
b = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null (Bag a
b Bag a -> a -> [a]
forall a. Ord a => Bag a -> a -> [a]
! a
a)
count :: Ord a => a -> Bag a -> Int
count :: forall a. Ord a => a -> Bag a -> Int
count a
a Bag a
b = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Bag a
b Bag a -> a -> [a]
forall a. Ord a => Bag a -> a -> [a]
! a
a)
empty :: Bag a
empty :: forall a. Bag a
empty = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> Map a [a] -> Bag a
forall a b. (a -> b) -> a -> b
$ Map a [a]
forall k a. Map k a
Map.empty
singleton :: a -> Bag a
singleton :: forall a. a -> Bag a
singleton a
a = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> Map a [a] -> Bag a
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Map a [a]
forall k a. k -> a -> Map k a
Map.singleton a
a [a
a]
union :: Ord a => Bag a -> Bag a -> Bag a
union :: forall a. Ord a => Bag a -> Bag a -> Bag a
union (Bag Map a [a]
b) (Bag Map a [a]
c) = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> Map a [a] -> Bag a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> [a]) -> Map a [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Map a [a]
b Map a [a]
c
unions :: Ord a => [Bag a] -> Bag a
unions :: forall a. Ord a => [Bag a] -> Bag a
unions = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> ([Bag a] -> Map a [a]) -> [Bag a] -> Bag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> [Map a [a]] -> Map a [a]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([Map a [a]] -> Map a [a])
-> ([Bag a] -> [Map a [a]]) -> [Bag a] -> Map a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bag a -> Map a [a]) -> [Bag a] -> [Map a [a]]
forall a b. (a -> b) -> [a] -> [b]
List.map Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
insert :: Ord a => a -> Bag a -> Bag a
insert :: forall a. Ord a => a -> Bag a -> Bag a
insert a
a = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> (Bag a -> Map a [a]) -> Bag a -> Bag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> a -> [a] -> Map a [a] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) a
a [a
a] (Map a [a] -> Map a [a])
-> (Bag a -> Map a [a]) -> Bag a -> Map a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
fromList :: Ord a => [a] -> Bag a
fromList :: forall a. Ord a => [a] -> Bag a
fromList = Map a [a] -> Bag a
forall a. Map a [a] -> Bag a
Bag (Map a [a] -> Bag a) -> ([a] -> Map a [a]) -> [a] -> Bag a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> [(a, [a])] -> Map a [a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([(a, [a])] -> Map a [a])
-> ([a] -> [(a, [a])]) -> [a] -> Map a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, [a])) -> [a] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ a
a -> (a
a,[a
a]))
groups :: Bag a -> [[a]]
groups :: forall a. Bag a -> [[a]]
groups = Map a [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map a [a] -> [[a]]) -> (Bag a -> Map a [a]) -> Bag a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
toList :: Bag a -> [a]
toList :: forall a. Bag a -> [a]
toList = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> (Bag a -> [[a]]) -> Bag a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> [[a]]
forall a. Bag a -> [[a]]
groups
keys :: Bag a -> [a]
keys :: forall a. Bag a -> [a]
keys = Map a [a] -> [a]
forall k a. Map k a -> [k]
Map.keys (Map a [a] -> [a]) -> (Bag a -> Map a [a]) -> Bag a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
elems :: Bag a -> [a]
elems :: forall a. Bag a -> [a]
elems = Bag a -> [a]
forall a. Bag a -> [a]
toList
toAscList :: Bag a -> [a]
toAscList :: forall a. Bag a -> [a]
toAscList = Bag a -> [a]
forall a. Bag a -> [a]
toList
map :: Ord b => (a -> b) -> Bag a -> Bag b
map :: forall b a. Ord b => (a -> b) -> Bag a -> Bag b
map a -> b
f = Map b [b] -> Bag b
forall a. Map a [a] -> Bag a
Bag (Map b [b] -> Bag b) -> (Bag a -> Map b [b]) -> Bag a -> Bag b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> [b] -> [b]) -> [(b, [b])] -> Map b [b]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([(b, [b])] -> Map b [b])
-> (Bag a -> [(b, [b])]) -> Bag a -> Map b [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> (b, [b])) -> [[a]] -> [(b, [b])]
forall a b. (a -> b) -> [a] -> [b]
List.map [a] -> (b, [b])
ff ([[a]] -> [(b, [b])]) -> (Bag a -> [[a]]) -> Bag a -> [(b, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map a [a] -> [[a]]) -> (Bag a -> Map a [a]) -> Bag a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
where
ff :: [a] -> (b, [b])
ff (a
a : [a]
as) = (b
b, b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f [a]
as) where b :: b
b = a -> b
f a
a
ff [] = (b, [b])
forall a. HasCallStack => a
__IMPOSSIBLE__
traverse' :: forall a b m . (Applicative m, Ord b) =>
(a -> m b) -> Bag a -> m (Bag b)
traverse' :: forall a b (m :: * -> *).
(Applicative m, Ord b) =>
(a -> m b) -> Bag a -> m (Bag b)
traverse' a -> m b
f = (Map b [b] -> Bag b
forall a. Map a [a] -> Bag a
Bag (Map b [b] -> Bag b)
-> ([(b, [b])] -> Map b [b]) -> [(b, [b])] -> Bag b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> [b] -> [b]) -> [(b, [b])] -> Map b [b]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++)) ([(b, [b])] -> Bag b)
-> (Bag a -> m [(b, [b])]) -> Bag a -> m (Bag b)
forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> ([a] -> m (b, [b])) -> [[a]] -> m [(b, [b])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [a] -> m (b, [b])
trav ([[a]] -> m [(b, [b])])
-> (Bag a -> [[a]]) -> Bag a -> m [(b, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems (Map a [a] -> [[a]]) -> (Bag a -> Map a [a]) -> Bag a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> Map a [a]
forall a. Bag a -> Map a [a]
bag
where
trav :: [a] -> m (b, [b])
trav :: [a] -> m (b, [b])
trav (a
a : [a]
as) = (\ b
b [b]
bs -> (b
b, b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs)) (b -> [b] -> (b, [b])) -> m b -> m ([b] -> (b, [b]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a m ([b] -> (b, [b])) -> m [b] -> m (b, [b])
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m b
f [a]
as
trav [] = m (b, [b])
forall a. HasCallStack => a
__IMPOSSIBLE__
instance Show a => Show (Bag a) where
showsPrec :: Int -> Bag a -> ShowS
showsPrec Int
_ (Bag Map a [a]
b) = (String
"Agda.Utils.Bag.Bag (" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a [a] -> ShowS
forall a. Show a => a -> ShowS
shows Map a [a]
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')'Char -> ShowS
forall a. a -> [a] -> [a]
:)
instance Ord a => Semigroup (Bag a) where
<> :: Bag a -> Bag a -> Bag a
(<>) = Bag a -> Bag a -> Bag a
forall a. Ord a => Bag a -> Bag a -> Bag a
union
instance Ord a => Monoid (Bag a) where
mempty :: Bag a
mempty = Bag a
forall a. Bag a
empty
mappend :: Bag a -> Bag a -> Bag a
mappend = Bag a -> Bag a -> Bag a
forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [Bag a] -> Bag a
mconcat = [Bag a] -> Bag a
forall a. Ord a => [Bag a] -> Bag a
unions
instance Foldable Bag where
foldMap :: forall m a. Monoid m => (a -> m) -> Bag a -> m
foldMap a -> m
f = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> (Bag a -> [a]) -> Bag a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag a -> [a]
forall a. Bag a -> [a]
toList