{-
(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 #-}

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

        emptyBag, unitBag, unionBags, unionManyBags,
        mapBag,
        elemBag, lengthBag,
        filterBag, partitionBag, partitionBagWith,
        concatBag, catBagMaybes, foldBag,
        isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,
        listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL,
        concatMapBag, concatMapBagPair, mapMaybeBag, unzipBag,
        mapBagM, mapBagM_,
        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 ( (<>) )

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 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
product :: forall a. Num a => Bag a -> a
$cproduct :: forall a. Num a => Bag a -> a
sum :: forall a. Num a => Bag a -> a
$csum :: forall a. Num a => Bag a -> a
minimum :: forall a. Ord a => Bag a -> a
$cminimum :: forall a. Ord a => Bag a -> a
maximum :: forall a. Ord a => Bag a -> a
$cmaximum :: forall a. Ord a => Bag a -> a
elem :: forall a. Eq a => a -> Bag a -> Bool
$celem :: forall a. Eq a => a -> Bag a -> Bool
length :: forall a. Bag a -> Int
$clength :: forall a. Bag a -> Int
null :: forall a. Bag a -> Bool
$cnull :: forall a. Bag a -> Bool
toList :: forall a. Bag a -> [a]
$ctoList :: forall a. Bag a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Bag a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bag a -> a
foldr1 :: forall a. (a -> a -> a) -> Bag a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Bag a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bag a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bag a -> m
fold :: forall m. Monoid m => Bag m -> m
$cfold :: forall m. Monoid m => Bag m -> m
Foldable, 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
<$ :: forall a b. a -> Bag b -> Bag a
$c<$ :: forall a b. a -> Bag b -> Bag a
fmap :: forall a b. (a -> b) -> Bag a -> Bag b
$cfmap :: forall a b. (a -> b) -> Bag a -> Bag b
Functor, Functor Bag
Foldable 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)
sequence :: forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
$csequence :: forall (m :: * -> *) a. Monad m => Bag (m a) -> m (Bag a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Bag (f a) -> f (Bag a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Bag (f a) -> f (Bag a)
traverse :: 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)
Traversable)

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

unitBag :: a -> Bag a
unitBag :: forall a. a -> Bag a
unitBag  = 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) = forall a. Bag a -> Int
lengthBag Bag a
b1 forall a. Num a => a -> a -> a
+ forall a. Bag a -> Int
lengthBag Bag a
b2
lengthBag (ListBag NonEmpty a
xs)    = 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 forall a. Eq a => a -> a -> Bool
== a
y
elemBag a
x (TwoBags Bag a
b1 Bag a
b2) = a
x forall a. Eq a => a -> Bag a -> Bool
`elemBag` Bag a
b1 Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> Bag a -> Bool
`elemBag` Bag a
b2
elemBag a
x (ListBag NonEmpty a
ys)    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a
x 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bag a -> Bag a -> Bag a
unionBags 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      = 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 = (forall a. a -> Bag a
unitBag a
elt) 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 forall a. Bag a -> Bag a -> Bag a
`unionBags` (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)) = 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 = 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 forall a. Bag a
EmptyBag
filterBag a -> Bool
pred (TwoBags Bag a
b1 Bag a
b2) = Bag a
sat1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2
    where sat1 :: Bag a
sat1 = forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred Bag a
b1
          sat2 :: Bag a
sat2 = forall a. (a -> Bool) -> Bag a -> Bag a
filterBag a -> Bool
pred Bag a
b2
filterBag a -> Bool
pred (ListBag NonEmpty a
vs)    = forall a. [a] -> Bag a
listToBag (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred (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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bag a
EmptyBag
filterBagM a -> m Bool
pred b :: Bag a
b@(UnitBag a
val) = do
  Bool
flag <- a -> m Bool
pred a
val
  if Bool
flag then forall (m :: * -> *) a. Monad m => a -> m a
return Bag a
b
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bag a
EmptyBag
filterBagM a -> m Bool
pred (TwoBags Bag a
b1 Bag a
b2) = do
  Bag a
sat1 <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Bag a -> m (Bag a)
filterBagM a -> m Bool
pred Bag a
b1
  Bag a
sat2 <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Bag a -> m (Bag a)
filterBagM a -> m Bool
pred Bag a
b2
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bag a
sat1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2)
filterBagM a -> m Bool
pred (ListBag NonEmpty a
vs) = do
  [a]
sat <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM a -> m Bool
pred (forall l. IsList l => l -> [Item l]
toList NonEmpty a
vs)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Bag a
listToBag [a]
sat)

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) = forall a. (a -> Bool) -> Bag a -> Bool
allBag a -> Bool
p Bag a
b1 Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> Bag a -> Bool
allBag a -> Bool
p Bag a
b2
allBag a -> Bool
p (ListBag NonEmpty a
xs)    = 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) = forall a. (a -> Bool) -> Bag a -> Bool
anyBag a -> Bool
p Bag a
b1 Bool -> Bool -> Bool
|| forall a. (a -> Bool) -> Bag a -> Bool
anyBag a -> Bool
p Bag a
b2
anyBag a -> Bool
p (ListBag NonEmpty a
xs)    = 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        = 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 Bool
flag <- forall (m :: * -> *) a. Monad m => (a -> m Bool) -> Bag a -> m Bool
anyBagM a -> m Bool
p Bag a
b1
                               if Bool
flag then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                                       else forall (m :: * -> *) a. Monad m => (a -> m Bool) -> Bag a -> m Bool
anyBagM a -> m Bool
p Bag a
b2
anyBagM a -> m Bool
p (ListBag NonEmpty a
xs)    = forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
(a -> m Bool) -> f a -> m Bool
anyM a -> m Bool
p NonEmpty a
xs

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

catBagMaybes :: Bag (Maybe a) -> Bag a
catBagMaybes :: forall a. Bag (Maybe a) -> Bag a
catBagMaybes Bag (Maybe a)
bs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Maybe a -> Bag a -> Bag a
add 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 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 = (forall a. Bag a
EmptyBag, 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, forall a. Bag a
EmptyBag) else (forall a. Bag a
EmptyBag, Bag a
b)
partitionBag a -> Bool
pred (TwoBags Bag a
b1 Bag a
b2)
    = (Bag a
sat1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2, Bag a
fail1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
fail2)
  where (Bag a
sat1, Bag a
fail1) = forall a. (a -> Bool) -> Bag a -> (Bag a, Bag a)
partitionBag a -> Bool
pred Bag a
b1
        (Bag a
sat2, Bag a
fail2) = 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) = (forall a. [a] -> Bag a
listToBag [a]
sats, forall a. [a] -> Bag a
listToBag [a]
fails)
  where ([a]
sats, [a]
fails) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
pred (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 = (forall a. Bag a
EmptyBag, 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  -> (forall a. a -> Bag a
UnitBag b
a, forall a. Bag a
EmptyBag)
         Right c
b -> (forall a. Bag a
EmptyBag, forall a. a -> Bag a
UnitBag c
b)
partitionBagWith a -> Either b c
pred (TwoBags Bag a
b1 Bag a
b2)
    = (Bag b
sat1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
sat2, Bag c
fail1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag c
fail2)
  where (Bag b
sat1, Bag c
fail1) = 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) = 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) = (forall a. [a] -> Bag a
listToBag [b]
sats, forall a. [a] -> Bag a
listToBag [c]
fails)
  where ([b]
sats, [c]
fails) = forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith a -> Either b c
pred (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) = forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
t a -> r
u (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)    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (r -> r -> r
tforall 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 = 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        = 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) = forall a. Bag a -> Bag a -> Bag a
unionBags (forall a b. (a -> Bag b) -> Bag a -> Bag b
concatMapBag a -> Bag b
f Bag a
b1) (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)    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Bag a -> Bag a -> Bag a
unionBags forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bag b
f) 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        = (forall a. Bag a
EmptyBag, 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) = (forall a. Bag a -> Bag a -> Bag a
unionBags Bag b
r1 Bag b
r2, forall a. Bag a -> Bag a -> Bag a
unionBags Bag c
s1 Bag c
s2)
  where
    (Bag b
r1, Bag c
s1) = 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) = 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)    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Bag b, Bag c) -> (Bag b, Bag c)
go (forall a. Bag a
emptyBag, 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) = (forall a. Bag a -> Bag a -> Bag a
unionBags Bag b
r1 Bag b
s1, 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        = forall a. Bag a
EmptyBag
mapMaybeBag a -> Maybe b
f (UnitBag a
x)     = case a -> Maybe b
f a
x of
                                  Maybe b
Nothing -> forall a. Bag a
EmptyBag
                                  Just b
y  -> forall a. a -> Bag a
UnitBag b
y
mapMaybeBag a -> Maybe b
f (TwoBags Bag a
b1 Bag a
b2) = forall a. Bag a -> Bag a -> Bag a
unionBags (forall a b. (a -> Maybe b) -> Bag a -> Bag b
mapMaybeBag a -> Maybe b
f Bag a
b1) (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)    = forall a. [a] -> Bag a
listToBag forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f (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        = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bag a
EmptyBag
mapBagM a -> m b
f (UnitBag a
x)     = do b
r <- a -> m b
f a
x
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Bag a
UnitBag b
r)
mapBagM a -> m b
f (TwoBags Bag a
b1 Bag a
b2) = do Bag b
r1 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM a -> m b
f Bag a
b1
                               Bag b
r2 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM a -> m b
f Bag a
b2
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Bag a -> Bag a -> Bag a
TwoBags Bag b
r1 Bag b
r2)
mapBagM a -> m b
f (ListBag    NonEmpty a
xs) = do NonEmpty b
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f NonEmpty a
xs
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. NonEmpty a -> Bag a
ListBag NonEmpty b
rs)

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        = forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapBagM_ a -> m b
f (UnitBag a
x)     = a -> m b
f a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapBagM_ a -> m b
f (TwoBags Bag a
b1 Bag a
b2) = forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ a -> m b
f Bag a
b1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m b
f NonEmpty a
xs

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        = forall (m :: * -> *) a. Monad m => a -> m a
return 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 Bag b
r1 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM a -> m (Bag b)
f Bag a
b1
                                   Bag b
r2 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM a -> m (Bag b)
f Bag a
b2
                                   forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2)
flatMapBagM a -> m (Bag b)
f (ListBag    NonEmpty a
xs) = 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 forall a. Bag a
EmptyBag NonEmpty a
xs
  where
    k :: a -> Bag b -> m (Bag b)
k a
x Bag b
b2 = do { Bag b
b1 <- a -> m (Bag b)
f a
x; forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
b1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
b2) }

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        = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Bag a
EmptyBag, 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 (Bag b
r1,Bag c
s1) <- 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
                                       (Bag b
r2,Bag c
s2) <- 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
b2
                                       forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2, Bag c
s1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag c
s2)
flatMapBagPairM a -> m (Bag b, Bag c)
f (ListBag    NonEmpty a
xs) = 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 (forall a. Bag a
EmptyBag, 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 { (Bag b
r1,Bag c
s1) <- a -> m (Bag b, Bag c)
f a
x
                     ; forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2, Bag c
s1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag c
s2) }

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

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, 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, 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') = 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') = 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, 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') = 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', 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        = forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, forall a. Bag a
EmptyBag)
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (UnitBag x
x)     = do { (acc
s1, y
x1) <- acc -> x -> m (acc, y)
f acc
s x
x; forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s1, forall a. a -> Bag a
UnitBag y
x1) }
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (TwoBags Bag x
b1 Bag x
b2) = do { (acc
s1, Bag y
b1') <- 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
                                       ; (acc
s2, Bag y
b2') <- 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
s1 Bag x
b2
                                       ; forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s2, forall a. Bag a -> Bag a -> Bag a
TwoBags Bag y
b1' Bag y
b2') }
mapAccumBagLM acc -> x -> m (acc, y)
f acc
s (ListBag NonEmpty x
xs)    = do { (acc
s', NonEmpty y
xs') <- 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
                                       ; forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s', forall a. NonEmpty a -> Bag a
ListBag NonEmpty y
xs') }

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

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

bagToList :: Bag a -> [a]
bagToList :: forall a. Bag a -> [a]
bagToList 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 = (forall a. Bag a
EmptyBag, forall a. Bag a
EmptyBag)
unzipBag (UnitBag (a
a, b
b)) = (forall a. a -> Bag a
UnitBag a
a, forall a. a -> Bag a
UnitBag b
b)
unzipBag (TwoBags Bag (a, b)
xs1 Bag (a, b)
xs2) = (forall a. Bag a -> Bag a -> Bag a
TwoBags Bag a
as1 Bag a
as2, forall a. Bag a -> Bag a -> Bag a
TwoBags Bag b
bs1 Bag b
bs2)
  where
    (Bag a
as1, Bag b
bs1) = forall a b. Bag (a, b) -> (Bag a, Bag b)
unzipBag Bag (a, b)
xs1
    (Bag a
as2, Bag b
bs2) = forall a b. Bag (a, b) -> (Bag a, Bag b)
unzipBag Bag (a, b)
xs2
unzipBag (ListBag NonEmpty (a, b)
xs) = (forall a. NonEmpty a -> Bag a
ListBag NonEmpty a
as, forall a. NonEmpty a -> Bag a
ListBag NonEmpty b
bs)
  where
    (NonEmpty a
as, NonEmpty b
bs) = 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 = forall a. Maybe a
Nothing
headMaybe (UnitBag a
v) = forall a. a -> Maybe a
Just a
v
headMaybe (TwoBags Bag a
b1 Bag a
_) = forall a. Bag a -> Maybe a
headMaybe Bag a
b1
headMaybe (ListBag (a
v:|[a]
_)) = forall a. a -> Maybe a
Just a
v

instance (Outputable a) => Outputable (Bag a) where
    ppr :: Bag a -> SDoc
ppr Bag a
bag = forall doc. IsLine doc => doc -> doc
braces (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr (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 = forall g. g -> c g
z forall a. [a] -> Bag a
listToBag forall d b. Data d => c (d -> b) -> d -> c b
`k` forall a. Bag a -> [a]
bagToList Bag a
b -- traverse abstract type abstractly
  toConstr :: Bag a -> Constr
toConstr Bag a
_   = String -> Constr
abstractConstr forall a b. (a -> b) -> a -> b
$ String
"Bag("forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined::a))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
_  = 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  = 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 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 = forall a. [a] -> Bag a
listToBag
  toList :: Bag a -> [Item (Bag a)]
toList   = forall a. Bag a -> [a]
bagToList

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

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