Add failing for traversals

optics-core/src/Optics/AffineFold.hs

@@ -46,7 +46,7 @@ module Optics.AffineFold
   -- there 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.
-  , afailing
+  , afailing_
 
   -- * Subtyping
   , An_AffineFold
@@ -127,20 +127,20 @@ filtered p = afoldVL (\point f a -> if p a then f a else point a)
 
 -- | Try the first 'AffineFold'. If it returns no entry, try the second one.
 --
--- >>> preview (ix 1 % re _Left `afailing` ix 2 % re _Right) [0,1,2,3]
+-- >>> preview (ix 1 % re _Left `afailing_` ix 2 % re _Right) [0,1,2,3]
 -- Just (Left 1)
 --
--- >>> preview (ix 42 % re _Left `afailing` ix 2 % re _Right) [0,1,2,3]
+-- >>> preview (ix 42 % re _Left `afailing_` ix 2 % re _Right) [0,1,2,3]
 -- Just (Right 2)
 --
-afailing
+afailing_
   :: (Is k An_AffineFold, Is l An_AffineFold)
   => Optic' k is s a
   -> Optic' l js s a
   -> AffineFold s a
-afailing a b = afolding $ \s -> maybe (preview b s) Just (preview a s)
-infixl 3 `afailing` -- Same as (<|>)
-{-# INLINE afailing #-}
+afailing_ a b = afolding $ \s -> maybe (preview b s) Just (preview a s)
+infixl 3 `afailing_` -- Same as (<|>)
+{-# INLINE afailing_ #-}
 
 -- | Check to see if this 'AffineFold' doesn't match.
 --

optics-core/src/Optics/AffineTraversal.hs

@@ -48,6 +48,8 @@ module Optics.AffineTraversal
   -- * Additional elimination forms
   , withAffineTraversal
 
+  , afailing
+
   -- * Subtyping
   , An_AffineTraversal
   -- | <<diagrams/AffineTraversal.png AffineTraversal in the optics hierarchy>>
@@ -63,6 +65,7 @@ module Optics.AffineTraversal
 import Data.Profunctor.Indexed
 
 import Optics.Internal.Optic
+import Optics.Internal.Utils
 
 -- | Type synonym for a type-modifying affine traversal.
 type AffineTraversal s t a b = Optic An_AffineTraversal NoIx s t a b
@@ -165,6 +168,19 @@ matching :: Is k An_AffineTraversal => Optic k is s t a b -> s -> Either t a
 matching o = withAffineTraversal o $ \match _ -> match
 {-# INLINE matching #-}
 
+afailing
+  :: (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
+afailing 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 `afailing` -- Same as (<|>)
+{-# INLINE afailing #-}
+
 -- | 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/Fold.hs

@@ -91,7 +91,7 @@ module Optics.Fold
   -- used to combine optics of different kinds.  When porting code from @lens@
   -- that uses '<>' to combine folds, use 'summing' instead.
   , summing
-  , failing
+  , failing_
 
   -- * Subtyping
   , A_Fold
@@ -279,23 +279,23 @@ infixr 6 `summing` -- Same as (<>)
 
 -- | Try the first 'Fold'. If it returns no entries, try the second one.
 --
--- >>> toListOf (ix 1 `failing` ix 0) [4,7]
+-- >>> toListOf (ix 1 `failing_` ix 0) [4,7]
 -- [7]
--- >>> toListOf (ix 1 `failing` ix 0) [4]
+-- >>> toListOf (ix 1 `failing_` ix 0) [4]
 -- [4]
 --
-failing
+failing_
   :: (Is k A_Fold, Is l A_Fold)
   => Optic' k is s a
   -> Optic' l js s a
   -> Fold s a
-failing a b = foldVL $ \f s ->
+failing_ a b = foldVL $ \f s ->
   let OrT visited fu = traverseOf_ a (wrapOrT . f) s
   in if visited
      then fu
      else traverseOf_ b f s
-infixl 3 `failing` -- Same as (<|>)
-{-# INLINE failing #-}
+infixl 3 `failing_` -- Same as (<|>)
+{-# INLINE failing_ #-}
 
 ----------------------------------------
 -- Special folds

optics-core/src/Optics/IxAffineFold.hs

@@ -48,7 +48,7 @@ module Optics.IxAffineFold
   -- there 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.
-  , iafailing
+  , iafailing_
 
   -- * Subtyping
   , An_AffineFold
@@ -129,13 +129,13 @@ filteredBy p = iafoldVL $ \point f s -> case preview p s of
 
 -- | Try the first 'IxAffineFold'. If it returns no entry, try the second one.
 --
-iafailing
+iafailing_
   :: (Is k An_AffineFold, Is l An_AffineFold,
       is1 `HasSingleIndex` i, is2 `HasSingleIndex` i)
   => Optic' k is1 s a
   -> Optic' l is2 s a
   -> IxAffineFold i s a
-iafailing a b = conjoined (afailing a b) $ iafolding $ \s ->
+iafailing_ a b = conjoined (afailing_ a b) $ iafolding $ \s ->
   maybe (ipreview b s) Just (ipreview a s)
-infixl 3 `iafailing` -- Same as (<|>)
-{-# INLINE iafailing #-}
+infixl 3 `iafailing_` -- Same as (<|>)
+{-# INLINE iafailing_ #-}

optics-core/src/Optics/IxFold.hs

@@ -59,7 +59,7 @@ module Optics.IxFold
   -- not a unique choice of monoid to use, and the ('<>') operator could not be
   -- used to combine optics of different kinds.
   , isumming
-  , ifailing
+  , ifailing_
 
   -- * Subtyping
   , A_Fold
@@ -265,18 +265,18 @@ infixr 6 `isumming` -- Same as (<>)
 -- >>> itoListOf (_1 % ifolded `ifailing` _2 % ifolded) ([], ["b","c"])
 -- [(0,"b"),(1,"c")]
 --
-ifailing
+ifailing_
   :: (Is k A_Fold, Is l A_Fold, is1 `HasSingleIndex` i, is2 `HasSingleIndex` i)
   => Optic' k is1 s a
   -> Optic' l is2 s a
   -> IxFold i s a
-ifailing a b = conjoined (failing a b) $ ifoldVL $ \f s ->
+ifailing_ a b = conjoined (failing_ a b) $ ifoldVL $ \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 `ifailing` -- Same as (<|>)
-{-# INLINE ifailing #-}
+infixl 3 `ifailing_` -- Same as (<|>)
+{-# INLINE ifailing_ #-}
 
 ----------------------------------------
 -- Special folds

optics-core/src/Optics/IxTraversal.hs

@@ -76,6 +76,7 @@ module Optics.IxTraversal
   -- and the ('<>') operator could not be used to combine optics of different
   -- kinds.
   , iadjoin
+  , ifailing
 
   -- * Subtyping
   , A_Traversal
@@ -356,6 +357,20 @@ isingular o = conjoined (singular o) $ iatraversalVL $ \point f s ->
       Nothing ->                pure a
 {-# INLINE isingular #-}
 
+ifailing
+  :: ( 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
+ifailing a b = conjoined (failing 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 `ifailing` -- Same as (<|>)
+{-# INLINE ifailing #-}
+
 -- | Combine two disjoint indexed traversals into one.
 --
 -- >>> iover (_1 % itraversed `iadjoin` _2 % itraversed) (+) ([0, 0, 0], (3, 5))

optics-core/src/Optics/Traversal.hs

@@ -83,6 +83,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
+  , failing
 
   -- * Subtyping
   , A_Traversal
@@ -385,6 +386,20 @@ singular o = atraversalVL $ \point f s ->
       Nothing ->                pure a
 {-# INLINE singular #-}
 
+failing
+  :: (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
+failing 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 `failing` -- Same as (<|>)
+{-# INLINE failing #-}
+
+
 -- | Combine two disjoint traversals into one.
 --
 -- >>> over (_1 % _Just `adjoin` _2 % _Right) not (Just True, Right False)

optics-th/src/Optics/TH/Internal/Product.hs

@@ -935,4 +935,4 @@ addFieldClassName n = modify $ S.insert n
 
 -- We want to catch type families, but not *data* families. See #799.
 typeFamilyHead :: AffineFold Dec TypeFamilyHead
-typeFamilyHead = _OpenTypeFamilyD `afailing` _ClosedTypeFamilyD % _1
+typeFamilyHead = _OpenTypeFamilyD `afailing_` _ClosedTypeFamilyD % _1