Add oneOf1 and oneOfMap1 to Data.Semigroup.Foldable

purescript · Oct 23, 2020 · 6e84c1d · 6e84c1d
1 parent be73dca
commit 6e84c1d
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 1 deletion.
diff --git a/src/Data/Semigroup/Foldable.purs b/src/Data/Semigroup/Foldable.purs
@@ -7,6 +7,8 @@ module Data.Semigroup.Foldable
   , traverse1_
   , for1_
   , sequence1_
+  , oneOf1
+  , oneOfMap1
   , foldMap1Default
   , fold1Default
   , fold1DefaultR
@@ -21,7 +23,9 @@ module Data.Semigroup.Foldable
 
 import Prelude
 
+import Control.Alt (class Alt, alt)
 import Data.Foldable (class Foldable)
+import Data.Monoid.Alternate (Alternate(..))
 import Data.Monoid.Dual (Dual(..))
 import Data.Monoid.Multiplicative (Multiplicative(..))
 import Data.Newtype (ala, alaF)
@@ -115,6 +119,14 @@ for1_ = flip traverse1_
 sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit
 sequence1_ = traverse1_ identity
 
+-- | Combines a non empty collection of elements using the `Alt` operation.
+oneOf1 :: forall f g a. Foldable1 f => Alt g => f (g a) -> g a
+oneOf1 = foldr1 alt
+
+-- | Folds a non empty structure into some `Alt`.
+oneOfMap1 :: forall f g a b. Foldable1 f => Alt g => (a -> g b) -> f a -> g b
+oneOfMap1 = alaF Alternate foldMap1
+
 maximum :: forall f a. Ord a => Foldable1 f => f a -> a
 maximum = ala Max foldMap1
 

diff --git a/test/Main.purs b/test/Main.purs
@@ -13,7 +13,7 @@ import Data.Int (toNumber, pow)
 import Data.Maybe (Maybe(..))
 import Data.Monoid.Additive (Additive(..))
 import Data.Newtype (unwrap)
-import Data.Semigroup.Foldable (class Foldable1, foldr1, foldl1, fold1Default, foldr1Default, foldl1Default)
+import Data.Semigroup.Foldable (class Foldable1, foldr1, foldl1, fold1Default, foldr1Default, foldl1Default, oneOf1, oneOfMap1)
 import Data.Traversable (class Traversable, sequenceDefault, traverse, sequence, traverseDefault)
 import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
 import Effect (Effect, foreachE)
@@ -200,6 +200,13 @@ main = do
   assert $ "(a(b(cd)))" == foldMap (foldr1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"])
   assert $ "(((ab)c)d)" == foldMap (foldl1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"])
 
+  log "Test oneOf1"
+  assert $ Just "a" == (maybeMkNEArray [Nothing, Just "a", Just "b"] >>= oneOf1)
+
+  log "Test oneOfMap1" *> do
+    let pred n = if n >= 5 then Just n else Nothing
+    assert $ Just 5 == (maybeMkNEArray [1, 5, 10, 20] >>= oneOfMap1 pred)
+
   log "All done!"