- Bag a {- Don't -})
-partitionBag pred EmptyBag = (EmptyBag, EmptyBag)
-partitionBag pred b@(UnitBag val) = if pred val then (b, EmptyBag) else (EmptyBag, b)
-partitionBag pred (TwoBags b1 b2) = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
- where
- (sat1,fail1) = partitionBag pred b1
- (sat2,fail2) = partitionBag pred b2
-partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)
- where
- (sats,fails) = partition pred 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
+ Bag a {- Don't -})
+partitionBag _ EmptyBag = (EmptyBag, EmptyBag)
+partitionBag pred b@(UnitBag val)
+ = if pred val then (b, EmptyBag) else (EmptyBag, b)
+partitionBag pred (TwoBags b1 b2)
+ = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
+ where (sat1, fail1) = partitionBag pred b1
+ (sat2, fail2) = partitionBag pred b2
+partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)
+ where (sats, fails) = partition pred vs
+
+
+partitionBagWith :: (a -> Either b c) -> Bag a
+ -> (Bag b {- Left -},
+ Bag c {- Right -})
+partitionBagWith _ EmptyBag = (EmptyBag, EmptyBag)
+partitionBagWith pred (UnitBag val)
+ = case pred val of
+ Left a -> (UnitBag a, EmptyBag)
+ Right b -> (EmptyBag, UnitBag b)
+partitionBagWith pred (TwoBags b1 b2)
+ = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
+ where (sat1, fail1) = partitionBagWith pred b1
+ (sat2, fail2) = partitionBagWith pred b2
+partitionBagWith pred (ListBag vs) = (listToBag sats, listToBag fails)
+ where (sats, fails) = partitionWith pred 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