Add failing for traversals, redux

optics-core/src/Optics/AffineTraversal.hs

@@ -48,6 +48,12 @@ module Optics.AffineTraversal
   -- * Additional elimination forms
   , withAffineTraversal
 
+  -- * Monoid structure
+  -- | 'AffineTraversal' admits a monoid structure where 'adisjoin' returns the
+  -- result from the second affine traversal only if the first does not return a
+  -- result. The identity element is 'ignored' (which traverses no elements).
+  , adisjoin
+
   -- * Subtyping
   , An_AffineTraversal
   -- | <<diagrams/AffineTraversal.png AffineTraversal in the optics hierarchy>>
@@ -63,6 +69,7 @@ module Optics.AffineTraversal
 import Data.Profunctor.Indexed
 
 import Optics.Internal.Optic
+import Optics.Internal.Utils
 
 -- $setup
 -- >>> import Optics.Core
@@ -168,6 +175,29 @@ matching :: Is k An_AffineTraversal => Optic k is s t a b -> s -> Either t a
 matching o = withAffineTraversal o $ \match _ -> match
 {-# INLINE matching #-}
 
+-- | Try the first 'AffineTraversal'. If it does not return an entry, try the
+-- second one.
+--
+-- >>> over (ix 2 `adisjoin` ix 1) (*5) [1,2,3]
+-- [1,2,15]
+-- >>> over (ix 2 `adisjoin` ix 1) (*5) [1,2]
+-- [1,10]
+--
+-- @since 0.4.3
+--
+adisjoin
+  :: (Is k An_AffineTraversal, Is l An_AffineTraversal)
+  => Optic k is s t a b
+  -> Optic l js s t a b
+  -> AffineTraversal s t a b
+adisjoin a b = atraversalVL $ \point f s ->
+  let OrT visited fu = atraverseOf a (OrT False . point) (wrapOrT . f) s
+  in if visited
+     then fu
+     else atraverseOf b point f s
+infixl 3 `adisjoin` -- Same as (<|>)
+{-# INLINE adisjoin #-}
+
 -- | Filter result(s) of a traversal that don't satisfy a predicate.
 --
 -- /Note:/ This is /not/ a legal 'Optics.Traversal.Traversal', unless you are

optics-core/src/Optics/IxAffineTraversal.hs

@@ -36,6 +36,13 @@ module Optics.IxAffineTraversal
   -- * Additional introduction forms
   , ignored
 
+  -- * Monoid structure
+  -- | 'IxAffineTraversal' admits a monoid structure where 'iadisjoin' returns
+  -- the result from the second indexed affine traversal only if the first does
+  -- not return a result. The identity element is 'ignored' (which traverses no
+  -- elements).
+  , iadisjoin
+
   -- * Subtyping
   , An_AffineTraversal
 
@@ -49,6 +56,7 @@ module Optics.IxAffineTraversal
 import Data.Profunctor.Indexed
 
 import Optics.AffineFold
+import Optics.AffineTraversal
 import Optics.Internal.Indexed
 import Optics.Internal.Optic
 import Optics.Internal.Utils
@@ -130,6 +138,31 @@ ignored :: IxAffineTraversal i s s a b
 ignored = iatraversalVL $ \point _ -> point
 {-# INLINE ignored #-}
 
+-- | Try the first 'IxAffineTraversal'. If it does not return a entry, try the
+-- second one.
+--
+-- >>> iover (ifst `iadisjoin` isnd) (++) ("foo", "bar")
+-- ("barfoo","bar")
+--
+-- >>> iover (ignored `iadisjoin` isnd) (++) ("foo", "bar")
+-- ("foo","foobar")
+--
+-- @since 0.4.3
+--
+iadisjoin
+  :: ( Is k An_AffineTraversal, Is l An_AffineTraversal
+     , is1 `HasSingleIndex` i, is2 `HasSingleIndex` i)
+  => Optic k is1 s t a b
+  -> Optic l is2 s t a b
+  -> IxAffineTraversal i s t a b
+iadisjoin a b = conjoined (adisjoin a b) $ iatraversalVL $ \point f s ->
+  let OrT visited fu = iatraverseOf a (OrT False . point) (\i -> wrapOrT . f i) s
+  in if visited
+     then fu
+     else iatraverseOf b point f s
+infixl 3 `iadisjoin` -- Same as (<|>)
+{-# INLINE iadisjoin #-}
+
 -- $setup
 -- >>> import Optics.Core
 -- >>> import Data.Void (absurd)

optics-core/src/Optics/IxTraversal.hs

@@ -59,10 +59,16 @@ module Optics.IxTraversal
   , ipartsOf
   , isingular
 
-  -- * Monoid structure
-  -- | 'IxTraversal' admits a (partial) monoid structure where 'iadjoin'
-  -- combines non-overlapping indexed traversals, and the identity element is
-  -- 'ignored' (which traverses no elements).
+  -- * Monoid structures
+  -- | 'IxTraversal' admits two monoid structures:
+  --
+  -- * 'iadjoin' combines non-overlapping indexed traversals.
+  --
+  -- * 'idisjoin' returns results from the second indexed traversal only if the
+  --   first returns no results.
+  --
+  -- In both cases, the identity element is 'ignored' (which traverses no
+  -- elements).
   --
   -- If you merely need an 'IxFold', you can use indexed traversals as indexed
   -- folds and combine them with one of the monoid structures on indexed folds
@@ -75,6 +81,7 @@ module Optics.IxTraversal
   -- and the ('<>') operator could not be used to combine optics of different
   -- kinds.
   , iadjoin
+  , idisjoin
 
   -- * Subtyping
   , A_Traversal
@@ -355,6 +362,30 @@ isingular o = conjoined (singular o) $ iatraversalVL $ \point f s ->
       Nothing ->                pure a
 {-# INLINE isingular #-}
 
+-- | Try the first 'IxTraversal'. If it returns no entries, try the second one.
+--
+-- >>> iover (_1 % itraversed `idisjoin` _2 % itraversed) (+) ([0, 0, 0], (3, 5))
+-- ([0,1,2],(3,5))
+--
+-- >>> iover (ignored `idisjoin` _2 % itraversed) (+) ([0, 0, 0], (3, 5))
+-- ([0,0,0],(3,8))
+--
+-- @since 0.4.3
+--
+idisjoin
+  :: ( Is k A_Traversal, Is l A_Traversal
+     , is1 `HasSingleIndex` i, is2 `HasSingleIndex` i)
+  => Optic k is1 s t a b
+  -> Optic l is2 s t a b
+  -> IxTraversal i s t a b
+idisjoin a b = conjoined (disjoin a b) $ itraversalVL $ \f s ->
+  let OrT visited fu = itraverseOf a (\i -> wrapOrT . f i) s
+  in if visited
+     then fu
+     else itraverseOf b f s
+infixl 3 `idisjoin` -- Same as (<|>)
+{-# INLINE idisjoin #-}
+
 -- | Combine two disjoint indexed traversals into one.
 --
 -- >>> iover (_1 % itraversed `iadjoin` _2 % itraversed) (+) ([0, 0, 0], (3, 5))

optics-core/src/Optics/Traversal.hs

@@ -69,10 +69,16 @@ module Optics.Traversal
   , unsafePartsOf
   , singular
 
-  -- * Monoid structure
-  -- | 'Traversal' admits a (partial) monoid structure where 'adjoin' combines
-  -- non-overlapping traversals, and the identity element is
-  -- 'Optics.IxAffineTraversal.ignored' (which traverses no elements).
+  -- * Monoid structures
+  -- | 'Traversal' admits two monoid structures:
+  --
+  -- * 'adjoin' combines non-overlapping traversals.
+  --
+  -- * 'disjoin' returns results from the second traversal only if the first
+  --   returns no results.
+  --
+  -- In both cases, the identity element is 'Optics.IxAffineTraversal.ignored'
+  -- (which traverses no elements).
   --
   -- If you merely need a 'Fold', you can use traversals as folds and combine
   -- them with one of the monoid structures on folds (see
@@ -84,6 +90,7 @@ module Optics.Traversal
   -- is not a unique choice of monoid to use that works for all optics, and the
   -- ('<>') operator could not be used to combine optics of different kinds.
   , adjoin
+  , disjoin
 
   -- * Subtyping
   , A_Traversal
@@ -430,6 +437,28 @@ singular o = atraversalVL $ \point f s ->
       Nothing ->                pure a
 {-# INLINE singular #-}
 
+-- | Try the first 'Traversal'. If it returns no entries, try the second one.
+--
+-- >>> over (_1 `disjoin` _2) succ (0, 0)
+-- (1,0)
+-- >>> over (ignored `disjoin` _2) succ (0, 0)
+-- (0,1)
+--
+-- @since 0.4.3
+--
+disjoin
+  :: (Is k A_Traversal, Is l A_Traversal)
+  => Optic k is s t a b
+  -> Optic l js s t a b
+  -> Traversal s t a b
+disjoin a b = traversalVL $ \f s ->
+  let OrT visited fu = traverseOf a (wrapOrT . f) s
+  in if visited
+     then fu
+     else traverseOf b f s
+infixl 3 `disjoin` -- Same as (<|>)
+{-# INLINE disjoin #-}
+
 -- | Combine two disjoint traversals into one.
 --
 -- >>> over (_1 % _Just `adjoin` _2 % _Right) not (Just True, Right False)