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


Bag: an unordered collection with duplicates
-}

{-# LANGUAGE ScopedTypeVariables, DeriveFunctor, 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,
        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, listToMaybe )
import Data.List ( partition, mapAccumL )
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.Foldable as Foldable
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 [a]             -- INVARIANT: the list is non-empty
  deriving (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)

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 [a]
xs)    = forall (t :: * -> *) a. Foldable t => t a -> Int
length [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 [a]
ys)    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a
x forall a. Eq a => a -> a -> Bool
==) [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]
xs)  = forall a. [a] -> Bool
isSingleton [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 [a]
vs)    = forall a. [a] -> Bag a
listToBag (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred [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 [a]
vs) = do
  [a]
sat <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM a -> m Bool
pred [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 [a]
xs)    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p [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 [a]
xs)    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
p [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 [a]
xs)    = forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
p [a]
xs

concatBag :: Bag (Bag a) -> Bag a
concatBag :: forall a. Bag (Bag a) -> Bag a
concatBag Bag (Bag a)
bss = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bag a -> Bag a -> Bag a
add forall a. Bag a
emptyBag Bag (Bag a)
bss
  where
    add :: Bag a -> Bag a -> Bag a
add Bag a
bs Bag a
rs = Bag a
bs forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
rs

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 [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 [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 [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 [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 [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 [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 [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 [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 [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) [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 [a]
xs)    = forall a. [a] -> Bag a
ListBag (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [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    [a]
xs) = do [b]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f [a]
xs
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Bag a
ListBag [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    [a]
xs) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m b
f [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    [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 [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    [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) [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 [a]
xs)    = do [(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 [a]
xs
                                       let ([b]
rs,[c]
ss) = forall a b. [(a, b)] -> ([a], [b])
unzip [(b, c)]
ts
                                       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Bag a
ListBag [b]
rs, forall a. [a] -> Bag a
ListBag [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 [x]
xs)    = let (acc
s', [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 [x]
xs
                                   in (acc
s', forall a. [a] -> Bag a
ListBag [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 [x]
xs)    = do { (acc
s', [y]
xs') <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s [x]
xs
                                       ; forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s', forall a. [a] -> Bag a
ListBag [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]
vs = forall a. [a] -> Bag a
ListBag [a]
vs

nonEmptyToBag :: NonEmpty a -> Bag a
nonEmptyToBag :: forall a. NonEmpty a -> Bag a
nonEmptyToBag (a
x :| []) = forall a. a -> Bag a
UnitBag a
x
nonEmptyToBag (a
x :| [a]
xs) = forall a. [a] -> Bag a
ListBag (a
x forall a. a -> [a] -> [a]
: [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

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]
l) = forall a. [a] -> Maybe a
listToMaybe [a]
l

instance (Outputable a) => Outputable (Bag a) where
    ppr :: Bag a -> SDoc
ppr Bag a
bag = SDoc -> SDoc
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 Foldable.Foldable Bag where
  foldr :: forall a b. (a -> b -> b) -> b -> Bag a -> b
foldr a -> b -> b
_ b
z Bag a
EmptyBag        = b
z
  foldr a -> b -> b
k b
z (UnitBag a
x)     = a -> b -> b
k a
x b
z
  foldr a -> b -> b
k b
z (TwoBags Bag a
b1 Bag a
b2) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z Bag a
b2) Bag a
b1
  foldr a -> b -> b
k b
z (ListBag [a]
xs)    = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z [a]
xs

  foldl :: forall b a. (b -> a -> b) -> b -> Bag a -> b
foldl b -> a -> b
_ b
z Bag a
EmptyBag        = b
z
  foldl b -> a -> b
k b
z (UnitBag a
x)     = b -> a -> b
k b
z a
x
  foldl b -> a -> b
k b
z (TwoBags Bag a
b1 Bag a
b2) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
k (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
k b
z Bag a
b1) Bag a
b2
  foldl b -> a -> b
k b
z (ListBag [a]
xs)    = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
k b
z [a]
xs

  foldl' :: forall b a. (b -> a -> b) -> b -> Bag a -> b
foldl' b -> a -> b
_ b
z Bag a
EmptyBag        = b
z
  foldl' b -> a -> b
k b
z (UnitBag a
x)     = b -> a -> b
k b
z a
x
  foldl' b -> a -> b
k b
z (TwoBags Bag a
b1 Bag a
b2) = let r1 :: b
r1 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
z Bag a
b1 in seq :: forall a b. a -> b -> b
seq b
r1 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
r1 Bag a
b2
  foldl' b -> a -> b
k b
z (ListBag [a]
xs)    = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
z [a]
xs

instance Traversable Bag where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bag a -> f (Bag b)
traverse a -> f b
_ Bag a
EmptyBag        = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Bag a
EmptyBag
  traverse a -> f b
f (UnitBag a
x)     = forall a. a -> Bag a
UnitBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
  traverse a -> f b
f (TwoBags Bag a
b1 Bag a
b2) = forall a. Bag a -> Bag a -> Bag a
TwoBags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Bag a
b1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Bag a
b2
  traverse a -> f b
f (ListBag [a]
xs)    = forall a. [a] -> Bag a
ListBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
xs

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