{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998


Bag: an unordered collection with duplicates
-}

{-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-}
{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-data-list-nonempty-unzip #-}

module GHC.Data.Bag (
        Bag, -- abstract type

        emptyBag, unitBag, unionBags, unionManyBags,
        mapBag, pprBag,
        elemBag, lengthBag,
        filterBag, partitionBag, partitionBagWith,
        concatBag, catBagMaybes, foldBag,
        isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,
        listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL,
        concatMapBag, concatMapBagPair, mapMaybeBag, mapMaybeBagM, unzipBag,
        mapBagM, mapBagM_, lookupBag,
        flatMapBagM, flatMapBagPairM,
        mapAndUnzipBagM, mapAccumBagLM,
        anyBagM, filterBagM
    ) where

import GHC.Prelude

import GHC.Exts ( IsList(..) )
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Monad
import Control.Monad
import Data.Data
import Data.Maybe( mapMaybe )
import Data.List ( partition, mapAccumL )
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup ( (<>) )
import Control.Applicative( Alternative( (<|>) ) )
import Control.DeepSeq

infixr 3 `consBag`
infixl 3 `snocBag`

data Bag a
  = EmptyBag
  | UnitBag a
  | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty
  | ListBag (NonEmpty a)
  deriving ((forall m. Monoid m => Bag m -> m)
-> (forall m a. Monoid m => (a -> m) -> Bag a -> m)
-> (forall m a. Monoid m => (a -> m) -> Bag a -> m)
-> (forall a b. (a -> b -> b) -> b -> Bag a -> b)
-> (forall a b. (a -> b -> b) -> b -> Bag a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bag a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bag a -> b)
-> (forall a. (a -> a -> a) -> Bag a -> a)
-> (forall a. (a -> a -> a) -> Bag a -> a)
-> (forall a. Bag a -> [a])
-> (forall a. Bag a -> Bool)
-> (forall a. Bag a -> Int)
-> (forall a. Eq a => a -> Bag a -> Bool)
-> (forall a. Ord a => Bag a -> a)
-> (forall a. Ord a => Bag a -> a)
-> (forall a. Num a => Bag a -> a)
-> (forall a. Num a => Bag a -> a)
-> Foldable Bag
forall a. Eq a => a -> Bag a -> Bool
forall a. Num a => Bag a -> a
forall a. Ord a => Bag a -> a
forall m. Monoid m => Bag m -> m
forall a. Bag a -> Bool
forall a. Bag a -> Int
forall a. Bag a -> [a]
forall a. (a -> a -> a) -> Bag a -> a
forall m a. Monoid m => (a -> m) -> Bag a -> m
forall b a. (b -> a -> b) -> b -> Bag a -> b
forall a b. (a -> b -> b) -> b -> Bag 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 m. Monoid m => Bag m -> m
fold :: forall m. Monoid m => Bag m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bag a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bag a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Bag a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Bag a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bag a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bag a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Bag a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bag a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Bag a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bag a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Bag a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Bag a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Bag a -> a
foldr1 :: forall a. (a -> a -> a) -> Bag a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bag a -> a
foldl1 :: forall a. (a -> a -> a) -> Bag a -> a
$ctoList :: forall a. Bag a -> [a]
toList :: forall a. Bag a -> [a]
$cnull :: forall a. Bag a -> Bool
null :: forall a. Bag a -> Bool
$clength :: forall a. Bag a -> Int
length :: forall a. Bag a -> Int
$celem :: forall a. Eq a => a -> Bag a -> Bool
elem :: forall a. Eq a => a -> Bag a -> Bool
$cmaximum :: forall a. Ord a => Bag a -> a
maximum :: forall a. Ord a => Bag a -> a
$cminimum :: forall a. Ord a => Bag a -> a
minimum :: forall a. Ord a => Bag a -> a
$csum :: forall a. Num a => Bag a -> a
sum :: forall a. Num a => Bag a -> a
$cproduct :: forall a. Num a => Bag a -> a
product :: forall a. Num a => Bag a -> a
Foldable, (forall a b. (a -> b) -> Bag a -> Bag b)
-> (forall a b. a -> Bag b -> Bag a) -> Functor Bag
forall a b. a -> Bag b -> Bag a
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Bag a -> Bag b
fmap :: forall a b. (a -> b) -> Bag a -> Bag b
$c<$ :: forall a b. a -> Bag b -> Bag a
<$ :: forall a b. a -> Bag b -> Bag a
Functor, Functor Bag
Foldable Bag
(Functor Bag, Foldable Bag) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Bag a -> f (Bag b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Bag (f a) -> f (Bag a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bag a -> m (Bag b))
-> (forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a))
-> Traversable Bag
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
forall (f :: * -> *) a. Applicative f => Bag (f a) -> f (Bag a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bag a -> f (Bag b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bag a -> f (Bag b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bag a -> f (Bag b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Bag (f a) -> f (Bag a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Bag (f a) -> f (Bag a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
$csequence :: forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
sequence :: forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
Traversable)

instance NFData a => NFData (Bag a) where
  rnf :: Bag a -> ()
rnf Bag a
EmptyBag = ()
  rnf (UnitBag a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (TwoBags Bag a
a Bag a
b) = Bag a -> ()
forall a. NFData a => a -> ()
rnf Bag a
a () -> () -> ()
forall a b. a -> b -> b
`seq` Bag a -> ()
forall a. NFData a => a -> ()
rnf Bag a
b
  rnf (ListBag NonEmpty a
a) = NonEmpty a -> ()
forall a. NFData a => a -> ()
rnf NonEmpty a
a

emptyBag :: Bag a
emptyBag :: forall a. Bag a
emptyBag = Bag a
forall a. Bag a
EmptyBag

unitBag :: a -> Bag a
unitBag :: forall a. a -> Bag a
unitBag  = a -> Bag a
forall a. a -> Bag a
UnitBag

lengthBag :: Bag a -> Int
lengthBag :: forall a. Bag a -> Int
lengthBag Bag a
EmptyBag        = Int
0
lengthBag (UnitBag {})    = Int
1
lengthBag (TwoBags Bag a
b1 Bag a
b2) = Bag a -> Int
forall a. Bag a -> Int
lengthBag Bag a
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bag a -> Int
forall a. Bag a -> Int
lengthBag Bag a
b2
lengthBag (ListBag NonEmpty a
xs)    = NonEmpty a -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
xs

elemBag :: Eq a => a -> Bag a -> Bool
elemBag :: forall a. Eq a => a -> Bag a -> Bool
elemBag a
_ Bag a
EmptyBag        = Bool
False
elemBag a
x (UnitBag a
y)     = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
elemBag a
x (TwoBags Bag a
b1 Bag a
b2) = a
x a -> Bag a -> Bool
forall a. Eq a => a -> Bag a -> Bool
`elemBag` Bag a
b1 Bool -> Bool -> Bool
|| a
x a -> Bag a -> Bool
forall a. Eq a => a -> Bag a -> Bool
`elemBag` Bag a
b2
elemBag a
x (ListBag NonEmpty a
ys)    = (a -> Bool) -> NonEmpty a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) NonEmpty a
ys

unionManyBags :: [Bag a] -> Bag a
unionManyBags :: forall a. [Bag a] -> Bag a
unionManyBags [Bag a]
xs = (Bag a -> Bag a -> Bag a) -> Bag a -> [Bag a] -> Bag a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
unionBags Bag a
forall a. Bag a
EmptyBag [Bag a]
xs

-- This one is a bit stricter! The bag will get completely evaluated.

unionBags :: Bag a -> Bag a -> Bag a
unionBags :: forall a. Bag a -> Bag a -> Bag a
unionBags Bag a
EmptyBag Bag a
b = Bag a
b
unionBags Bag a
b Bag a
EmptyBag = Bag a
b
unionBags Bag a
b1 Bag a
b2      = Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
TwoBags Bag a
b1 Bag a
b2

consBag :: a -> Bag a -> Bag a
snocBag :: Bag a -> a -> Bag a

consBag :: forall a. a -> Bag a -> Bag a
consBag a
elt Bag a
bag = (a -> Bag a
forall a. a -> Bag a
unitBag a
elt) Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
bag
snocBag :: forall a. Bag a -> a -> Bag a
snocBag Bag a
bag a
elt = Bag a
bag Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` (a -> Bag a
forall a. a -> Bag a
unitBag a
elt)

isEmptyBag :: Bag a -> Bool
isEmptyBag :: forall a. Bag a -> Bool
isEmptyBag Bag a
EmptyBag = Bool
True
isEmptyBag Bag a
_ = Bool
False

isSingletonBag :: Bag a -> Bool
isSingletonBag :: forall a. Bag a -> Bool
isSingletonBag Bag a
EmptyBag      = Bool
False
isSingletonBag (UnitBag a
_)   = Bool
True
isSingletonBag (TwoBags Bag a
_ Bag a
_) = Bool
False          -- Neither is empty
isSingletonBag (ListBag (a
_:|[a]
xs)) = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs

filterBag :: (a -> Bool) -> Bag a -> Bag a
filterBag :: forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
_    Bag a
EmptyBag = Bag a
forall a. Bag a
EmptyBag
filterBag a -> Bool
pred b :: Bag a
b@(UnitBag a
val) = if a -> Bool
pred a
val then Bag a
b else Bag a
forall a. Bag a
EmptyBag
filterBag a -> Bool
pred (TwoBags Bag a
b1 Bag a
b2) = Bag a
sat1 Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2
    where sat1 :: Bag a
sat1 = (a -> Bool) -> Bag a -> Bag a
forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred Bag a
b1
          sat2 :: Bag a
sat2 = (a -> Bool) -> Bag a -> Bag a
forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred Bag a
b2
filterBag a -> Bool
pred (ListBag NonEmpty a
vs)    = [a] -> Bag a
forall a. [a] -> Bag a
listToBag ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
vs))

filterBagM :: Monad m => (a -> m Bool) -> Bag a -> m (Bag a)
filterBagM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Bag a -> m (Bag a)
filterBagM a -> m Bool
_    Bag a
EmptyBag = Bag a -> m (Bag a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag a
forall a. Bag a
EmptyBag
filterBagM a -> m Bool
pred b :: Bag a
b@(UnitBag a
val) = do
  flag <- a -> m Bool
pred a
val
  if flag then return b
          else return EmptyBag
filterBagM a -> m Bool
pred (TwoBags Bag a
b1 Bag a
b2) = do
  sat1 <- (a -> m Bool) -> Bag a -> m (Bag a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Bag a -> m (Bag a)
filterBagM a -> m Bool
pred Bag a
b1
  sat2 <- filterBagM pred b2
  return (sat1 `unionBags` sat2)
filterBagM a -> m Bool
pred (ListBag NonEmpty a
vs) = do
  sat <- (a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM a -> m Bool
pred (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
vs)
  return (listToBag sat)
{-# INLINEABLE filterBagM #-}

lookupBag :: Eq a => a -> Bag (a,b) -> Maybe b
lookupBag :: forall a b. Eq a => a -> Bag (a, b) -> Maybe b
lookupBag a
_ Bag (a, b)
EmptyBag        = Maybe b
forall a. Maybe a
Nothing
lookupBag a
k (UnitBag (a, b)
kv)    = a -> (a, b) -> Maybe b
forall a b. Eq a => a -> (a, b) -> Maybe b
lookup_one a
k (a, b)
kv
lookupBag a
k (TwoBags Bag (a, b)
b1 Bag (a, b)
b2) = a -> Bag (a, b) -> Maybe b
forall a b. Eq a => a -> Bag (a, b) -> Maybe b
lookupBag a
k Bag (a, b)
b1 Maybe b -> Maybe b -> Maybe b
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Bag (a, b) -> Maybe b
forall a b. Eq a => a -> Bag (a, b) -> Maybe b
lookupBag a
k Bag (a, b)
b2
lookupBag a
k (ListBag NonEmpty (a, b)
xs)    = ((a, b) -> Maybe b -> Maybe b)
-> Maybe b -> NonEmpty (a, b) -> Maybe b
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe b -> Maybe b -> Maybe b
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe b -> Maybe b -> Maybe b)
-> ((a, b) -> Maybe b) -> (a, b) -> Maybe b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a, b) -> Maybe b
forall a b. Eq a => a -> (a, b) -> Maybe b
lookup_one a
k) Maybe b
forall a. Maybe a
Nothing NonEmpty (a, b)
xs
{-# INLINEABLE lookupBag #-}

lookup_one :: Eq a => a -> (a,b) -> Maybe b
lookup_one :: forall a b. Eq a => a -> (a, b) -> Maybe b
lookup_one a
k (a
k',b
v) | a
ka -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
k'     = b -> Maybe b
forall a. a -> Maybe a
Just b
v
                    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

allBag :: (a -> Bool) -> Bag a -> Bool
allBag :: forall a. (a -> Bool) -> Bag a -> Bool
allBag a -> Bool
_ Bag a
EmptyBag        = Bool
True
allBag a -> Bool
p (UnitBag a
v)     = a -> Bool
p a
v
allBag a -> Bool
p (TwoBags Bag a
b1 Bag a
b2) = (a -> Bool) -> Bag a -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
allBag a -> Bool
p Bag a
b1 Bool -> Bool -> Bool
&& (a -> Bool) -> Bag a -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
allBag a -> Bool
p Bag a
b2
allBag a -> Bool
p (ListBag NonEmpty a
xs)    = (a -> Bool) -> NonEmpty a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p NonEmpty a
xs

anyBag :: (a -> Bool) -> Bag a -> Bool
anyBag :: forall a. (a -> Bool) -> Bag a -> Bool
anyBag a -> Bool
_ Bag a
EmptyBag        = Bool
False
anyBag a -> Bool
p (UnitBag a
v)     = a -> Bool
p a
v
anyBag a -> Bool
p (TwoBags Bag a
b1 Bag a
b2) = (a -> Bool) -> Bag a -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag a -> Bool
p Bag a
b1 Bool -> Bool -> Bool
|| (a -> Bool) -> Bag a -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag a -> Bool
p Bag a
b2
anyBag a -> Bool
p (ListBag NonEmpty a
xs)    = (a -> Bool) -> NonEmpty a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p NonEmpty a
xs

anyBagM :: Monad m => (a -> m Bool) -> Bag a -> m Bool
anyBagM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> Bag a -> m Bool
anyBagM a -> m Bool
_ Bag a
EmptyBag        = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
anyBagM a -> m Bool
p (UnitBag a
v)     = a -> m Bool
p a
v
anyBagM a -> m Bool
p (TwoBags Bag a
b1 Bag a
b2) = do flag <- (a -> m Bool) -> Bag a -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> Bag a -> m Bool
anyBagM a -> m Bool
p Bag a
b1
                               if flag then return True
                                       else anyBagM p b2
anyBagM a -> m Bool
p (ListBag NonEmpty a
xs)    = (a -> m Bool) -> NonEmpty a -> m Bool
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
(a -> m Bool) -> f a -> m Bool
anyM a -> m Bool
p NonEmpty a
xs
{-# INLINEABLE anyBagM #-}

concatBag :: Bag (Bag a) -> Bag a
concatBag :: forall a. Bag (Bag a) -> Bag a
concatBag = (Bag a -> Bag a -> Bag a) -> Bag a -> Bag (Bag a) -> Bag a
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
unionBags Bag a
forall a. Bag a
emptyBag

catBagMaybes :: Bag (Maybe a) -> Bag a
catBagMaybes :: forall a. Bag (Maybe a) -> Bag a
catBagMaybes Bag (Maybe a)
bs = (Maybe a -> Bag a -> Bag a) -> Bag a -> Bag (Maybe a) -> Bag a
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe a -> Bag a -> Bag a
forall {a}. Maybe a -> Bag a -> Bag a
add Bag a
forall a. Bag a
emptyBag Bag (Maybe a)
bs
  where
    add :: Maybe a -> Bag a -> Bag a
add Maybe a
Nothing Bag a
rs = Bag a
rs
    add (Just a
x) Bag a
rs = a
x a -> Bag a -> Bag a
forall a. a -> Bag a -> Bag a
`consBag` Bag a
rs

partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predicate -},
                                         Bag a {- Don't -})
partitionBag :: forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
partitionBag a -> Bool
_    Bag a
EmptyBag = (Bag a
forall a. Bag a
EmptyBag, Bag a
forall a. Bag a
EmptyBag)
partitionBag a -> Bool
pred b :: Bag a
b@(UnitBag a
val)
    = if a -> Bool
pred a
val then (Bag a
b, Bag a
forall a. Bag a
EmptyBag) else (Bag a
forall a. Bag a
EmptyBag, Bag a
b)
partitionBag a -> Bool
pred (TwoBags Bag a
b1 Bag a
b2)
    = (Bag a
sat1 Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2, Bag a
fail1 Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
fail2)
  where (Bag a
sat1, Bag a
fail1) = (a -> Bool) -> Bag a -> (Bag a, Bag a)
forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
partitionBag a -> Bool
pred Bag a
b1
        (Bag a
sat2, Bag a
fail2) = (a -> Bool) -> Bag a -> (Bag a, Bag a)
forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
partitionBag a -> Bool
pred Bag a
b2
partitionBag a -> Bool
pred (ListBag NonEmpty a
vs) = ([a] -> Bag a
forall a. [a] -> Bag a
listToBag [a]
sats, [a] -> Bag a
forall a. [a] -> Bag a
listToBag [a]
fails)
  where ([a]
sats, [a]
fails) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
pred (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
vs)


partitionBagWith :: (a -> Either b c) -> Bag a
                    -> (Bag b {- Left  -},
                        Bag c {- Right -})
partitionBagWith :: forall a b c. (a -> Either b c) -> Bag a -> (Bag b, Bag c)
partitionBagWith a -> Either b c
_    Bag a
EmptyBag = (Bag b
forall a. Bag a
EmptyBag, Bag c
forall a. Bag a
EmptyBag)
partitionBagWith a -> Either b c
pred (UnitBag a
val)
    = case a -> Either b c
pred a
val of
         Left b
a  -> (b -> Bag b
forall a. a -> Bag a
UnitBag b
a, Bag c
forall a. Bag a
EmptyBag)
         Right c
b -> (Bag b
forall a. Bag a
EmptyBag, c -> Bag c
forall a. a -> Bag a
UnitBag c
b)
partitionBagWith a -> Either b c
pred (TwoBags Bag a
b1 Bag a
b2)
    = (Bag b
sat1 Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
sat2, Bag c
fail1 Bag c -> Bag c -> Bag c
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag c
fail2)
  where (Bag b
sat1, Bag c
fail1) = (a -> Either b c) -> Bag a -> (Bag b, Bag c)
forall a b c. (a -> Either b c) -> Bag a -> (Bag b, Bag c)
partitionBagWith a -> Either b c
pred Bag a
b1
        (Bag b
sat2, Bag c
fail2) = (a -> Either b c) -> Bag a -> (Bag b, Bag c)
forall a b c. (a -> Either b c) -> Bag a -> (Bag b, Bag c)
partitionBagWith a -> Either b c
pred Bag a
b2
partitionBagWith a -> Either b c
pred (ListBag NonEmpty a
vs) = ([b] -> Bag b
forall a. [a] -> Bag a
listToBag [b]
sats, [c] -> Bag c
forall a. [a] -> Bag a
listToBag [c]
fails)
  where ([b]
sats, [c]
fails) = (a -> Either b c) -> [a] -> ([b], [c])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith a -> Either b c
pred (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
vs)

foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative
        -> (a -> r)      -- Replace UnitBag with this
        -> r             -- Replace EmptyBag with this
        -> Bag a
        -> r

{- Standard definition
foldBag t u e EmptyBag        = e
foldBag t u e (UnitBag x)     = u x
foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)
foldBag t u e (ListBag xs)    = foldr (t.u) e xs
-}

-- More tail-recursive definition, exploiting associativity of "t"
foldBag :: forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
_ a -> r
_ r
e Bag a
EmptyBag        = r
e
foldBag r -> r -> r
t a -> r
u r
e (UnitBag a
x)     = a -> r
u a
x r -> r -> r
`t` r
e
foldBag r -> r -> r
t a -> r
u r
e (TwoBags Bag a
b1 Bag a
b2) = (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
t a -> r
u ((r -> r -> r) -> (a -> r) -> r -> Bag a -> r
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
t a -> r
u r
e Bag a
b2) Bag a
b1
foldBag r -> r -> r
t a -> r
u r
e (ListBag NonEmpty a
xs)    = (a -> r -> r) -> r -> NonEmpty a -> r
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (r -> r -> r
t(r -> r -> r) -> (a -> r) -> a -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> r
u) r
e NonEmpty a
xs

mapBag :: (a -> b) -> Bag a -> Bag b
mapBag :: forall a b. (a -> b) -> Bag a -> Bag b
mapBag = (a -> b) -> Bag a -> Bag b
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

concatMapBag :: (a -> Bag b) -> Bag a -> Bag b
concatMapBag :: forall a b. (a -> Bag b) -> Bag a -> Bag b
concatMapBag a -> Bag b
_ Bag a
EmptyBag        = Bag b
forall a. Bag a
EmptyBag
concatMapBag a -> Bag b
f (UnitBag a
x)     = a -> Bag b
f a
x
concatMapBag a -> Bag b
f (TwoBags Bag a
b1 Bag a
b2) = Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
unionBags ((a -> Bag b) -> Bag a -> Bag b
forall a b. (a -> Bag b) -> Bag a -> Bag b
concatMapBag a -> Bag b
f Bag a
b1) ((a -> Bag b) -> Bag a -> Bag b
forall a b. (a -> Bag b) -> Bag a -> Bag b
concatMapBag a -> Bag b
f Bag a
b2)
concatMapBag a -> Bag b
f (ListBag NonEmpty a
xs)    = (a -> Bag b -> Bag b) -> Bag b -> NonEmpty a -> Bag b
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
unionBags (Bag b -> Bag b -> Bag b) -> (a -> Bag b) -> a -> Bag b -> Bag b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bag b
f) Bag b
forall a. Bag a
emptyBag NonEmpty a
xs

concatMapBagPair :: (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
concatMapBagPair :: forall a b c. (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
concatMapBagPair a -> (Bag b, Bag c)
_ Bag a
EmptyBag        = (Bag b
forall a. Bag a
EmptyBag, Bag c
forall a. Bag a
EmptyBag)
concatMapBagPair a -> (Bag b, Bag c)
f (UnitBag a
x)     = a -> (Bag b, Bag c)
f a
x
concatMapBagPair a -> (Bag b, Bag c)
f (TwoBags Bag a
b1 Bag a
b2) = (Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
unionBags Bag b
r1 Bag b
r2, Bag c -> Bag c -> Bag c
forall a. Bag a -> Bag a -> Bag a
unionBags Bag c
s1 Bag c
s2)
  where
    (Bag b
r1, Bag c
s1) = (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
forall a b c. (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
concatMapBagPair a -> (Bag b, Bag c)
f Bag a
b1
    (Bag b
r2, Bag c
s2) = (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
forall a b c. (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
concatMapBagPair a -> (Bag b, Bag c)
f Bag a
b2
concatMapBagPair a -> (Bag b, Bag c)
f (ListBag NonEmpty a
xs)    = (a -> (Bag b, Bag c) -> (Bag b, Bag c))
-> (Bag b, Bag c) -> NonEmpty a -> (Bag b, Bag c)
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Bag b, Bag c) -> (Bag b, Bag c)
go (Bag b
forall a. Bag a
emptyBag, Bag c
forall a. Bag a
emptyBag) NonEmpty a
xs
  where
    go :: a -> (Bag b, Bag c) -> (Bag b, Bag c)
go a
a (Bag b
s1, Bag c
s2) = (Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
unionBags Bag b
r1 Bag b
s1, Bag c -> Bag c -> Bag c
forall a. Bag a -> Bag a -> Bag a
unionBags Bag c
r2 Bag c
s2)
      where
        (Bag b
r1, Bag c
r2) = a -> (Bag b, Bag c)
f a
a

mapMaybeBag :: (a -> Maybe b) -> Bag a -> Bag b
mapMaybeBag :: forall a b. (a -> Maybe b) -> Bag a -> Bag b
mapMaybeBag a -> Maybe b
_ Bag a
EmptyBag        = Bag b
forall a. Bag a
EmptyBag
mapMaybeBag a -> Maybe b
f (UnitBag a
x)     = case a -> Maybe b
f a
x of
                                  Maybe b
Nothing -> Bag b
forall a. Bag a
EmptyBag
                                  Just b
y  -> b -> Bag b
forall a. a -> Bag a
UnitBag b
y
mapMaybeBag a -> Maybe b
f (TwoBags Bag a
b1 Bag a
b2) = Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
unionBags ((a -> Maybe b) -> Bag a -> Bag b
forall a b. (a -> Maybe b) -> Bag a -> Bag b
mapMaybeBag a -> Maybe b
f Bag a
b1) ((a -> Maybe b) -> Bag a -> Bag b
forall a b. (a -> Maybe b) -> Bag a -> Bag b
mapMaybeBag a -> Maybe b
f Bag a
b2)
mapMaybeBag a -> Maybe b
f (ListBag NonEmpty a
xs)    = [b] -> Bag b
forall a. [a] -> Bag a
listToBag ([b] -> Bag b) -> [b] -> Bag b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
xs)

mapMaybeBagM :: Monad m => (a -> m (Maybe b)) -> Bag a -> m (Bag b)
mapMaybeBagM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Bag a -> m (Bag b)
mapMaybeBagM a -> m (Maybe b)
_ Bag a
EmptyBag        = Bag b -> m (Bag b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag b
forall a. Bag a
EmptyBag
mapMaybeBagM a -> m (Maybe b)
f (UnitBag a
x)     = do r <- a -> m (Maybe b)
f a
x
                                    return $ case r of
                                      Maybe b
Nothing -> Bag b
forall a. Bag a
EmptyBag
                                      Just b
y  -> b -> Bag b
forall a. a -> Bag a
UnitBag b
y
mapMaybeBagM a -> m (Maybe b)
f (TwoBags Bag a
b1 Bag a
b2) = do r1 <- (a -> m (Maybe b)) -> Bag a -> m (Bag b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Bag a -> m (Bag b)
mapMaybeBagM a -> m (Maybe b)
f Bag a
b1
                                    r2 <- mapMaybeBagM f b2
                                    return $ unionBags r1 r2
mapMaybeBagM a -> m (Maybe b)
f (ListBag NonEmpty a
xs)    = [b] -> Bag b
forall a. [a] -> Bag a
listToBag ([b] -> Bag b) -> m [b] -> m (Bag b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (Maybe b)) -> [a] -> m [b]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f (NonEmpty a -> [Item (NonEmpty a)]
forall l. IsList l => l -> [Item l]
toList NonEmpty a
xs)

mapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b)
mapBagM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM a -> m b
_ Bag a
EmptyBag        = Bag b -> m (Bag b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag b
forall a. Bag a
EmptyBag
mapBagM a -> m b
f (UnitBag a
x)     = do r <- a -> m b
f a
x
                               return (UnitBag r)
mapBagM a -> m b
f (TwoBags Bag a
b1 Bag a
b2) = do r1 <- (a -> m b) -> Bag a -> m (Bag b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM a -> m b
f Bag a
b1
                               r2 <- mapBagM f b2
                               return (TwoBags r1 r2)
mapBagM a -> m b
f (ListBag    NonEmpty a
xs) = do rs <- (a -> m b) -> NonEmpty a -> m (NonEmpty b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM a -> m b
f NonEmpty a
xs
                               return (ListBag rs)
{-# INLINEABLE mapBagM #-}

mapBagM_ :: Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ a -> m b
_ Bag a
EmptyBag        = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapBagM_ a -> m b
f (UnitBag a
x)     = a -> m b
f a
x m b -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapBagM_ a -> m b
f (TwoBags Bag a
b1 Bag a
b2) = (a -> m b) -> Bag a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ a -> m b
f Bag a
b1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> m b) -> Bag a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ a -> m b
f Bag a
b2
mapBagM_ a -> m b
f (ListBag    NonEmpty a
xs) = (a -> m b) -> NonEmpty a -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m b
f NonEmpty a
xs
{-# INLINEABLE mapBagM_ #-}

flatMapBagM :: Monad m => (a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM a -> m (Bag b)
_ Bag a
EmptyBag        = Bag b -> m (Bag b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag b
forall a. Bag a
EmptyBag
flatMapBagM a -> m (Bag b)
f (UnitBag a
x)     = a -> m (Bag b)
f a
x
flatMapBagM a -> m (Bag b)
f (TwoBags Bag a
b1 Bag a
b2) = do r1 <- (a -> m (Bag b)) -> Bag a -> m (Bag b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM a -> m (Bag b)
f Bag a
b1
                                   r2 <- flatMapBagM f b2
                                   return (r1 `unionBags` r2)
flatMapBagM a -> m (Bag b)
f (ListBag    NonEmpty a
xs) = (a -> Bag b -> m (Bag b)) -> Bag b -> NonEmpty a -> m (Bag b)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM a -> Bag b -> m (Bag b)
k Bag b
forall a. Bag a
EmptyBag NonEmpty a
xs
  where
    k :: a -> Bag b -> m (Bag b)
k a
x Bag b
b2 = do { b1 <- a -> m (Bag b)
f a
x; return (b1 `unionBags` b2) }
{-# INLINEABLE flatMapBagM #-}

flatMapBagPairM :: Monad m => (a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)
flatMapBagPairM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)
flatMapBagPairM a -> m (Bag b, Bag c)
_ Bag a
EmptyBag        = (Bag b, Bag c) -> m (Bag b, Bag c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
forall a. Bag a
EmptyBag, Bag c
forall a. Bag a
EmptyBag)
flatMapBagPairM a -> m (Bag b, Bag c)
f (UnitBag a
x)     = a -> m (Bag b, Bag c)
f a
x
flatMapBagPairM a -> m (Bag b, Bag c)
f (TwoBags Bag a
b1 Bag a
b2) = do (r1,s1) <- (a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m (Bag b, Bag c)) -> Bag a -> m (Bag b, Bag c)
flatMapBagPairM a -> m (Bag b, Bag c)
f Bag a
b1
                                       (r2,s2) <- flatMapBagPairM f b2
                                       return (r1 `unionBags` r2, s1 `unionBags` s2)
flatMapBagPairM a -> m (Bag b, Bag c)
f (ListBag    NonEmpty a
xs) = (a -> (Bag b, Bag c) -> m (Bag b, Bag c))
-> (Bag b, Bag c) -> NonEmpty a -> m (Bag b, Bag c)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM a -> (Bag b, Bag c) -> m (Bag b, Bag c)
k (Bag b
forall a. Bag a
EmptyBag, Bag c
forall a. Bag a
EmptyBag) NonEmpty a
xs
  where
    k :: a -> (Bag b, Bag c) -> m (Bag b, Bag c)
k a
x (Bag b
r2,Bag c
s2) = do { (r1,s1) <- a -> m (Bag b, Bag c)
f a
x
                     ; return (r1 `unionBags` r2, s1 `unionBags` s2) }
{-# INLINEABLE flatMapBagPairM #-}

mapAndUnzipBagM :: Monad m => (a -> m (b,c)) -> Bag a -> m (Bag b, Bag c)
mapAndUnzipBagM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m (b, c)) -> Bag a -> m (Bag b, Bag c)
mapAndUnzipBagM a -> m (b, c)
_ Bag a
EmptyBag        = (Bag b, Bag c) -> m (Bag b, Bag c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
forall a. Bag a
EmptyBag, Bag c
forall a. Bag a
EmptyBag)
mapAndUnzipBagM a -> m (b, c)
f (UnitBag a
x)     = do (r,s) <- a -> m (b, c)
f a
x
                                       return (UnitBag r, UnitBag s)
mapAndUnzipBagM a -> m (b, c)
f (TwoBags Bag a
b1 Bag a
b2) = do (r1,s1) <- (a -> m (b, c)) -> Bag a -> m (Bag b, Bag c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m (b, c)) -> Bag a -> m (Bag b, Bag c)
mapAndUnzipBagM a -> m (b, c)
f Bag a
b1
                                       (r2,s2) <- mapAndUnzipBagM f b2
                                       return (TwoBags r1 r2, TwoBags s1 s2)
mapAndUnzipBagM a -> m (b, c)
f (ListBag NonEmpty a
xs)    = do ts <- (a -> m (b, c)) -> NonEmpty a -> m (NonEmpty (b, c))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM a -> m (b, c)
f NonEmpty a
xs
                                       let (rs,ss) = NE.unzip ts
                                       return (ListBag rs, ListBag ss)
{-# INLINEABLE mapAndUnzipBagM #-}

mapAccumBagL ::(acc -> x -> (acc, y)) -- ^ combining function
            -> acc                    -- ^ initial state
            -> Bag x                  -- ^ inputs
            -> (acc, Bag y)           -- ^ final state, outputs
mapAccumBagL :: forall acc x y.
(acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
mapAccumBagL acc -> x -> (acc, y)
_ acc
s Bag x
EmptyBag        = (acc
s, Bag y
forall a. Bag a
EmptyBag)
mapAccumBagL acc -> x -> (acc, y)
f acc
s (UnitBag x
x)     = let (acc
s1, y
x1) = acc -> x -> (acc, y)
f acc
s x
x in (acc
s1, y -> Bag y
forall a. a -> Bag a
UnitBag y
x1)
mapAccumBagL acc -> x -> (acc, y)
f acc
s (TwoBags Bag x
b1 Bag x
b2) = let (acc
s1, Bag y
b1') = (acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
forall acc x y.
(acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
mapAccumBagL acc -> x -> (acc, y)
f acc
s  Bag x
b1
                                       (acc
s2, Bag y
b2') = (acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
forall acc x y.
(acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
mapAccumBagL acc -> x -> (acc, y)
f acc
s1 Bag x
b2
                                   in (acc
s2, Bag y -> Bag y -> Bag y
forall a. Bag a -> Bag a -> Bag a
TwoBags Bag y
b1' Bag y
b2')
mapAccumBagL acc -> x -> (acc, y)
f acc
s (ListBag NonEmpty x
xs)    = let (acc
s', NonEmpty y
xs') = (acc -> x -> (acc, y)) -> acc -> NonEmpty x -> (acc, NonEmpty y)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL acc -> x -> (acc, y)
f acc
s NonEmpty x
xs
                                   in (acc
s', NonEmpty y -> Bag y
forall a. NonEmpty a -> Bag a
ListBag NonEmpty y
xs')

mapAccumBagLM :: Monad m
            => (acc -> x -> m (acc, y)) -- ^ combining function
            -> acc                      -- ^ initial state
            -> Bag x                    -- ^ inputs
            -> m (acc, Bag y)           -- ^ final state, outputs
mapAccumBagLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> Bag x -> m (acc, Bag y)
mapAccumBagLM acc -> x -> m (acc, y)
_ acc
s Bag x
EmptyBag        = (acc, Bag y) -> m (acc, Bag y)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, Bag y
forall a. Bag a
EmptyBag)
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (UnitBag x
x)     = do { (s1, x1) <- acc -> x -> m (acc, y)
f acc
s x
x; return (s1, UnitBag x1) }
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (TwoBags Bag x
b1 Bag x
b2) = do { (s1, b1') <- (acc -> x -> m (acc, y)) -> acc -> Bag x -> m (acc, Bag y)
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> Bag x -> m (acc, Bag y)
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s  Bag x
b1
                                       ; (s2, b2') <- mapAccumBagLM f s1 b2
                                       ; return (s2, TwoBags b1' b2') }
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (ListBag NonEmpty x
xs)    = do { (s', xs') <- (acc -> x -> m (acc, y))
-> acc -> NonEmpty x -> m (acc, NonEmpty y)
forall (m :: * -> *) (t :: * -> *) acc x y.
(Monad m, Traversable t) =>
(acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
mapAccumLM acc -> x -> m (acc, y)
f acc
s NonEmpty x
xs
                                       ; return (s', ListBag xs') }
{-# INLINEABLE mapAccumBagLM #-}

listToBag :: [a] -> Bag a
listToBag :: forall a. [a] -> Bag a
listToBag [] = Bag a
forall a. Bag a
EmptyBag
listToBag [a
x] = a -> Bag a
forall a. a -> Bag a
UnitBag a
x
listToBag (a
x:[a]
xs) = NonEmpty a -> Bag a
forall a. NonEmpty a -> Bag a
ListBag (a
xa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|[a]
xs)

nonEmptyToBag :: NonEmpty a -> Bag a
nonEmptyToBag :: forall a. NonEmpty a -> Bag a
nonEmptyToBag (a
x :| []) = a -> Bag a
forall a. a -> Bag a
UnitBag a
x
nonEmptyToBag NonEmpty a
xs = NonEmpty a -> Bag a
forall a. NonEmpty a -> Bag a
ListBag NonEmpty a
xs

bagToList :: Bag a -> [a]
bagToList :: forall a. Bag a -> [a]
bagToList Bag a
b = (a -> [a] -> [a]) -> [a] -> Bag a -> [a]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] Bag a
b

unzipBag :: Bag (a, b) -> (Bag a, Bag b)
unzipBag :: forall a b. Bag (a, b) -> (Bag a, Bag b)
unzipBag Bag (a, b)
EmptyBag = (Bag a
forall a. Bag a
EmptyBag, Bag b
forall a. Bag a
EmptyBag)
unzipBag (UnitBag (a
a, b
b)) = (a -> Bag a
forall a. a -> Bag a
UnitBag a
a, b -> Bag b
forall a. a -> Bag a
UnitBag b
b)
unzipBag (TwoBags Bag (a, b)
xs1 Bag (a, b)
xs2) = (Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
TwoBags Bag a
as1 Bag a
as2, Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
TwoBags Bag b
bs1 Bag b
bs2)
  where
    (Bag a
as1, Bag b
bs1) = Bag (a, b) -> (Bag a, Bag b)
forall a b. Bag (a, b) -> (Bag a, Bag b)
unzipBag Bag (a, b)
xs1
    (Bag a
as2, Bag b
bs2) = Bag (a, b) -> (Bag a, Bag b)
forall a b. Bag (a, b) -> (Bag a, Bag b)
unzipBag Bag (a, b)
xs2
unzipBag (ListBag NonEmpty (a, b)
xs) = (NonEmpty a -> Bag a
forall a. NonEmpty a -> Bag a
ListBag NonEmpty a
as, NonEmpty b -> Bag b
forall a. NonEmpty a -> Bag a
ListBag NonEmpty b
bs)
  where
    (NonEmpty a
as, NonEmpty b
bs) = NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (a, b)
xs

headMaybe :: Bag a -> Maybe a
headMaybe :: forall a. Bag a -> Maybe a
headMaybe Bag a
EmptyBag = Maybe a
forall a. Maybe a
Nothing
headMaybe (UnitBag a
v) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
headMaybe (TwoBags Bag a
b1 Bag a
_) = Bag a -> Maybe a
forall a. Bag a -> Maybe a
headMaybe Bag a
b1
headMaybe (ListBag (a
v:|[a]
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
v

instance (Outputable a) => Outputable (Bag a) where
    ppr :: Bag a -> SDoc
ppr = Bag a -> SDoc
forall a. Outputable a => Bag a -> SDoc
pprBag

pprBag :: Outputable a => Bag a -> SDoc
pprBag :: forall a. Outputable a => Bag a -> SDoc
pprBag Bag a
bag = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ((a -> SDoc) -> [a] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bag a -> [a]
forall a. Bag a -> [a]
bagToList Bag a
bag))

instance Data a => Data (Bag a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bag a -> c (Bag a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z Bag a
b = ([a] -> Bag a) -> c ([a] -> Bag a)
forall g. g -> c g
z [a] -> Bag a
forall a. [a] -> Bag a
listToBag c ([a] -> Bag a) -> [a] -> c (Bag a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` Bag a -> [a]
forall a. Bag a -> [a]
bagToList Bag a
b -- traverse abstract type abstractly
  toConstr :: Bag a -> Constr
toConstr Bag a
_   = String -> Constr
abstractConstr (String -> Constr) -> String -> Constr
forall a b. (a -> b) -> a -> b
$ String
"Bag("String -> String -> String
forall a. [a] -> [a] -> [a]
++TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined::a))String -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bag a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c (Bag a)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: Bag a -> DataType
dataTypeOf Bag a
_ = String -> DataType
mkNoRepType String
"Bag"
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bag a))
dataCast1 forall d. Data d => c (t d)
x  = c (t a) -> Maybe (c (Bag a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
x

instance IsList (Bag a) where
  type Item (Bag a) = a
  fromList :: [Item (Bag a)] -> Bag a
fromList = [a] -> Bag a
[Item (Bag a)] -> Bag a
forall a. [a] -> Bag a
listToBag
  toList :: Bag a -> [Item (Bag a)]
toList   = Bag a -> [a]
Bag a -> [Item (Bag a)]
forall a. Bag a -> [a]
bagToList

instance Semigroup (Bag a) where
  <> :: Bag a -> Bag a -> Bag a
(<>) = Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
unionBags

instance Monoid (Bag a) where
  mempty :: Bag a
mempty = Bag a
forall a. Bag a
emptyBag