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


Bag: an unordered collection with duplicates
-}

{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-}

module Bag (
        Bag, -- abstract type

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

import GhcPrelude

import Outputable
import Util

import MonadUtils
import Control.Monad
import Data.Data
import Data.Maybe( mapMaybe )
import Data.List ( partition, mapAccumL )
import qualified Data.Foldable as Foldable

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 (a -> Bag b -> Bag a
(a -> b) -> Bag a -> Bag b
(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
<$ :: a -> Bag b -> Bag a
$c<$ :: forall a b. a -> Bag b -> Bag a
fmap :: (a -> b) -> Bag a -> Bag b
$cfmap :: forall a b. (a -> b) -> Bag a -> Bag b
Functor)

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

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

lengthBag :: Bag a -> Int
lengthBag :: 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 [a]
xs)    = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

elemBag :: Eq a => a -> Bag a -> Bool
elemBag :: 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 [a]
ys)    = (a -> Bool) -> [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
==) [a]
ys

unionManyBags :: [Bag a] -> Bag a
unionManyBags :: [Bag a] -> Bag a
unionManyBags [Bag a]
xs = (Bag a -> Bag a -> Bag a) -> Bag a -> [Bag a] -> Bag a
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 :: 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 :: 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 :: 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 :: Bag a -> Bool
isEmptyBag Bag a
EmptyBag = Bool
True
isEmptyBag Bag a
_        = Bool
False -- NB invariants

isSingletonBag :: Bag a -> Bool
isSingletonBag :: 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)  = [a] -> Bool
forall a. [a] -> Bool
isSingleton [a]
xs

filterBag :: (a -> Bool) -> Bag a -> Bag a
filterBag :: (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 [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 [a]
vs)

filterBagM :: Monad m => (a -> m Bool) -> Bag a -> m (Bag a)
filterBagM :: (a -> m Bool) -> Bag a -> m (Bag a)
filterBagM a -> m Bool
_    Bag a
EmptyBag = Bag a -> m (Bag 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
  Bool
flag <- a -> m Bool
pred a
val
  if Bool
flag then Bag a -> m (Bag a)
forall (m :: * -> *) a. Monad m => a -> m a
return Bag a
b
          else Bag a -> m (Bag a)
forall (m :: * -> *) a. Monad m => a -> m a
return Bag a
forall a. Bag a
EmptyBag
filterBagM a -> m Bool
pred (TwoBags Bag a
b1 Bag a
b2) = do
  Bag a
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
  Bag a
sat2 <- (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
b2
  Bag a -> m (Bag a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag a
sat1 Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
sat2)
filterBagM a -> m Bool
pred (ListBag [a]
vs) = do
  [a]
sat <- (a -> m Bool) -> [a] -> m [a]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM a -> m Bool
pred [a]
vs
  Bag a -> m (Bag a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Bag a
forall a. [a] -> Bag a
listToBag [a]
sat)

allBag :: (a -> Bool) -> Bag a -> Bool
allBag :: (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 [a]
xs)    = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p [a]
xs

anyBag :: (a -> Bool) -> Bag a -> Bool
anyBag :: (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 [a]
xs)    = (a -> Bool) -> [a] -> Bool
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 :: (a -> m Bool) -> Bag a -> m Bool
anyBagM a -> m Bool
_ Bag a
EmptyBag        = Bool -> m Bool
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 <- (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 Bool
flag then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                                       else (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
b2
anyBagM a -> m Bool
p (ListBag [a]
xs)    = (a -> m Bool) -> [a] -> m Bool
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 :: Bag (Bag a) -> Bag a
concatBag Bag (Bag a)
bss = (Bag a -> Bag a -> Bag a) -> Bag a -> Bag (Bag a) -> Bag a
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
add Bag a
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 Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag a
rs

catBagMaybes :: Bag (Maybe a) -> Bag a
catBagMaybes :: Bag (Maybe a) -> Bag a
catBagMaybes Bag (Maybe a)
bs = (Maybe a -> Bag a -> Bag a) -> Bag a -> Bag (Maybe a) -> Bag a
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 predictate -},
                                         Bag a {- Don't -})
partitionBag :: (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 [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 [a]
vs


partitionBagWith :: (a -> Either b c) -> Bag a
                    -> (Bag b {- Left  -},
                        Bag c {- Right -})
partitionBagWith :: (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 [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 [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 :: (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
_ a -> r
_ r
e Bag a
EmptyBag        = r
e
foldBag r -> r -> r
t a -> r
u r
e (UnitBag a
x)     = a -> r
u a
x r -> r -> r
`t` r
e
foldBag r -> r -> r
t a -> r
u r
e (TwoBags Bag a
b1 Bag a
b2) = (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
t a -> r
u ((r -> r -> r) -> (a -> r) -> r -> Bag a -> r
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag r -> r -> r
t a -> r
u r
e Bag a
b2) Bag a
b1
foldBag r -> r -> r
t a -> r
u r
e (ListBag [a]
xs)    = (a -> r -> r) -> r -> [a] -> r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (r -> r -> r
t(r -> r -> r) -> (a -> r) -> a -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> r
u) r
e [a]
xs

mapBag :: (a -> b) -> Bag a -> Bag b
mapBag :: (a -> b) -> Bag a -> Bag b
mapBag = (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 :: (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 [a]
xs)    = (a -> Bag b -> Bag b) -> Bag b -> [a] -> Bag 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 [a]
xs

concatMapBagPair :: (a -> (Bag b, Bag c)) -> Bag a -> (Bag b, Bag c)
concatMapBagPair :: (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 [a]
xs)    = (a -> (Bag b, Bag c) -> (Bag b, Bag c))
-> (Bag b, Bag c) -> [a] -> (Bag b, Bag c)
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) [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 :: (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 [a]
xs)    = [b] -> Bag b
forall a. [a] -> Bag a
ListBag ((a -> Maybe b) -> [a] -> [b]
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 :: (a -> m b) -> Bag a -> m (Bag b)
mapBagM a -> m b
_ Bag a
EmptyBag        = Bag b -> m (Bag b)
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 b
r <- a -> m b
f a
x
                               Bag b -> m (Bag b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Bag b
forall a. a -> Bag a
UnitBag b
r)
mapBagM a -> m b
f (TwoBags Bag a
b1 Bag a
b2) = do Bag b
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
                               Bag b
r2 <- (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
b2
                               Bag b -> m (Bag b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b -> Bag b -> Bag b
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 <- (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f [a]
xs
                               Bag b -> m (Bag b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> Bag b
forall a. [a] -> Bag a
ListBag [b]
rs)

mapBagM_ :: Monad m => (a -> m b) -> Bag a -> m ()
mapBagM_ :: (a -> m b) -> Bag a -> m ()
mapBagM_ a -> m b
_ Bag a
EmptyBag        = () -> m ()
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
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 (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    [a]
xs) = (a -> m b) -> [a] -> m ()
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 :: (a -> m (Bag b)) -> Bag a -> m (Bag b)
flatMapBagM a -> m (Bag b)
_ Bag a
EmptyBag        = Bag b -> m (Bag b)
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 Bag b
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
                                   Bag b
r2 <- (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
b2
                                   Bag b -> m (Bag b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2)
flatMapBagM a -> m (Bag b)
f (ListBag    [a]
xs) = (a -> Bag b -> m (Bag b)) -> Bag b -> [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 [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; Bag b -> m (Bag b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
b1 Bag b -> Bag b -> Bag b
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 :: (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 (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 (Bag b
r1,Bag c
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
                                       (Bag b
r2,Bag c
s2) <- (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
b2
                                       (Bag b, Bag c) -> m (Bag b, Bag c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2, Bag c
s1 Bag c -> Bag c -> Bag c
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag c
s2)
flatMapBagPairM a -> m (Bag b, Bag c)
f (ListBag    [a]
xs) = (a -> (Bag b, Bag c) -> m (Bag b, Bag c))
-> (Bag b, Bag c) -> [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) [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
                     ; (Bag b, Bag c) -> m (Bag b, Bag c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b
r1 Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag b
r2, Bag c
s1 Bag c -> Bag c -> Bag c
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 :: (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 (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 (b
r,c
s) <- a -> m (b, c)
f a
x
                                       (Bag b, Bag c) -> m (Bag b, Bag c)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Bag b
forall a. a -> Bag a
UnitBag b
r, c -> Bag c
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) <- (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
                                       (Bag b
r2,Bag c
s2) <- (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
b2
                                       (Bag b, Bag c) -> m (Bag b, Bag c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
TwoBags Bag b
r1 Bag b
r2, Bag c -> Bag c -> Bag c
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 <- (a -> m (b, c)) -> [a] -> m [(b, c)]
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) = [(b, c)] -> ([b], [c])
forall a b. [(a, b)] -> ([a], [b])
unzip [(b, c)]
ts
                                       (Bag b, Bag c) -> m (Bag b, Bag c)
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> Bag b
forall a. [a] -> Bag a
ListBag [b]
rs, [c] -> Bag c
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 :: (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 [x]
xs)    = let (acc
s', [y]
xs') = (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL acc -> x -> (acc, y)
f acc
s [x]
xs
                                   in (acc
s', [y] -> Bag y
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 :: (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 (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 { (acc
s1, y
x1) <- acc -> x -> m (acc, y)
f acc
s x
x; (acc, Bag y) -> m (acc, Bag y)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s1, y -> Bag y
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') <- (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
                                       ; (acc
s2, Bag y
b2') <- (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
s1 Bag x
b2
                                       ; (acc, Bag y) -> m (acc, Bag y)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s2, Bag y -> Bag y -> Bag y
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') <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
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
                                       ; (acc, Bag y) -> m (acc, Bag y)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s', [y] -> Bag y
forall a. [a] -> Bag a
ListBag [y]
xs') }

listToBag :: [a] -> Bag a
listToBag :: [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]
vs = [a] -> Bag a
forall a. [a] -> Bag a
ListBag [a]
vs

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

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

  foldl :: (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) = (b -> a -> b) -> b -> Bag a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
k ((b -> a -> b) -> b -> Bag a -> b
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)    = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
k b
z [a]
xs

  foldl' :: (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 = (b -> a -> b) -> b -> Bag a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
z Bag a
b1 in b -> b -> b
seq b
r1 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> b -> Bag 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)    = (b -> a -> b) -> b -> [a] -> b
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 :: (a -> f b) -> Bag a -> f (Bag b)
traverse a -> f b
_ Bag a
EmptyBag        = Bag b -> f (Bag b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bag b
forall a. Bag a
EmptyBag
  traverse a -> f b
f (UnitBag a
x)     = b -> Bag b
forall a. a -> Bag a
UnitBag (b -> Bag b) -> f b -> f (Bag b)
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) = Bag b -> Bag b -> Bag b
forall a. Bag a -> Bag a -> Bag a
TwoBags (Bag b -> Bag b -> Bag b) -> f (Bag b) -> f (Bag b -> Bag b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Bag a -> f (Bag 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 f (Bag b -> Bag b) -> f (Bag b) -> f (Bag b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Bag a -> f (Bag 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)    = [b] -> Bag b
forall a. [a] -> Bag a
ListBag ([b] -> Bag b) -> f [b] -> f (Bag b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [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