{-
(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_flip,
        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_flip :: (a -> b -> b) -> Bag a -> b -> b
-- Just foldr with flipped arguments,
-- so it can be chained more nicely
foldBag_flip :: forall a b. (a -> b -> b) -> Bag a -> b -> b
foldBag_flip a -> b -> b
k Bag a
bag b
z = (a -> b -> b) -> b -> Bag a -> b
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z Bag a
bag

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 a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty 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