alignment-0.1.0.5: src/Data/Alignment.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use fmap" #-}

module Data.Alignment(
-- * Types
  This(..)
-- * Type-classes
, Semialign(..)
, Align(..)
-- * Optics
, these
, those
, allThese
, allThese1
, allThese2
, allThose
, allThoseA
, allThoseAOr
, allThoseB
, allThoseBOr
, allTheseThoseA
, allTheseThoseA1
, allTheseThoseB
, allTheseThoseB1
) where

import Control.Applicative
    ( Applicative(liftA2, pure, (<*>)), (<$>), ZipList(ZipList) )
import Control.Category ( Category((.), id) )
import Control.Lens
    ( Identity(Identity),
      _Just,
      _Left,
      _Right,
      over,
      Field1(_1),
      Field2(_2),
      Lens,
      Lens',
      Traversal,
      Traversal',
      Traversal1 )
import Data.Bifoldable ( Bifoldable(bifoldMap) )
import Data.Bifunctor ( Bifunctor(bimap) )
import Data.Bifunctor.Swap ( Swap(..) )
import Data.Bitraversable ( Bitraversable(..) )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Bool ( (&&) )
import Data.Either ( Either(..), either )
import Data.Eq ( Eq((==)) )
import Data.Foldable ( Foldable(foldMap) )
import Data.Functor ( Functor(fmap), (<$) )
import Data.Functor.Apply ( Apply((<.>), liftF2) )
import Data.Functor.Classes
    ( compare1,
      eq1,
      showsPrec1,
      showsUnaryWith,
      Eq1(..),
      Ord1(..),
      Show1(..) )
import qualified Data.List.NonEmpty as NonEmpty(cons, toList)
import Data.Maybe ( Maybe(..), maybe )
import Data.Monoid ( (<>), Monoid(mempty) )
import Data.Ord ( Ord(compare) )
import Data.Semigroup ( Semigroup )
import Data.Semigroup.Bifoldable ( Bifoldable1(bifoldMap1) )
import Data.Semigroup.Bitraversable ( Bitraversable1(bitraverse1) )
import Data.Semigroup.Foldable ( Foldable1(foldMap1) )
import Data.Semigroup.Traversable ( Traversable1(traverse1) )
import Data.Traversable ( Traversable(traverse) )
import GHC.Show ( Show(showsPrec) )

-- $setup
-- >>> import Prelude

data This f a b =
  This
    (f (a, b))
    (Maybe (Either (NonEmpty a) (NonEmpty b)))

instance (Eq1 f, Eq a, Eq b) => Eq (This f a b) where
  This t1 r1 == This t2 r2 =
    t1 `eq1` t2 && r1 == r2

instance (Eq1 f, Eq a) => Eq1 (This f a) where
  liftEq f (This t1 r1) (This t2 r2) =
    liftEq (liftEq f) t1 t2 && liftEq (liftEq (liftEq f)) r1 r2

instance (Ord1 f, Ord a, Ord b) => Ord (This f a b) where
  This t1 r1 `compare` This t2 r2 =
    t1 `compare1` t2 <> r1 `compare` r2

instance (Ord1 f, Ord a) => Ord1 (This f a) where
  liftCompare f (This t1 r1) (This t2 r2) =
    liftCompare (liftCompare f) t1 t2 <> liftCompare (liftCompare (liftCompare f)) r1 r2

instance (Show1 f, Show a, Show b) => Show (This f a b) where
  showsPrec d (This t r) =
    showsUnaryWith showsPrec1 "This" d t . (" " <>) . showsPrec1 d r

instance (Show1 f, Show a) => Show1 (This f a) where
  liftShowsPrec sp sl d (This t r) =
    let showsPrecFt = liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)
        showsPrecFr = liftShowsPrec (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) (liftShowList (liftShowsPrec sp sl) (liftShowList sp sl))
    in  showsUnaryWith showsPrecFt "This" d t . (" " <>) . showsPrecFr d r

instance Functor f => Bifunctor (This f) where
  bimap f g (This t r) =
    This (fmap (bimap f g) t) (fmap (bimap (fmap f) (fmap g)) r)

instance Foldable f => Bifoldable (This f) where
  bifoldMap f g (This t r) =
    foldMap (bifoldMap f g) t <> foldMap (bifoldMap (foldMap f) (foldMap g)) r

instance Foldable1 f => Bifoldable1 (This f) where
  bifoldMap1 f g (This t r) =
    let x =
          foldMap1 (bifoldMap1 f g) t
    in  maybe x (either (foldMap1 f) (foldMap1 g)) r

instance Traversable f => Bitraversable (This f) where
  bitraverse f g (This t r) =
    This <$> traverse (bitraverse f g) t <*> traverse (bitraverse (traverse f) (traverse g)) r

instance Traversable1 f => Bitraversable1 (This f) where
  bitraverse1 f g (This t r) =
    let x =
          This <$> traverse1 (bitraverse1 f g) t
    in  maybe
          ((\k -> k Nothing) <$> x)
          (\q -> x <.> either (fmap (Just . Left) . traverse1 f) (fmap (Just . Right) . traverse1 g) q)
          r

instance Functor f => Functor (This f a) where
  fmap =
    bimap id

-- |
--
-- >>> This [("a", id), ("c", id)] Nothing <.> This [("A", "B"), ("C", "D")] Nothing
-- This [("aA","B"),("aC","D"),("cA","B"),("cC","D")] Nothing
-- >>> This [("a", id), ("c", id)] Nothing <.> This [("A", "B"), ("C", "D")] (Just (Left ("x":|[])))
-- This [("aA","B"),("aC","D"),("cA","B"),("cC","D")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] Nothing <.> This [("ABC", "DEF"), ("GHI", "JKL")] Nothing
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] Nothing <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Left ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] Nothing <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Right ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Left ("stu":|[]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] Nothing
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Right (id:|[reverse]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] Nothing
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Nothing
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Left ("stu":|[]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Left ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Just (Left ("stu" :| []))
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Left ("stu":|[]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Right ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Just (Left ("stu" :| []))
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Right (id:|[reverse]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Left ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Just (Left ("xyz" :| []))
-- >>> This [("abc", reverse), ("cde", reverse)] (Just (Left ("stu":|[]))) <.> This [("ABC", "DEF"), ("GHI", "JKL")] (Just (Right ("xyz":|[])))
-- This [("abcABC","FED"),("abcGHI","LKJ"),("cdeABC","FED"),("cdeGHI","LKJ")] Just (Left ("stu" :| []))
instance (Semigroup a, Apply f) => Apply (This f a) where
  This t1 r1 <.> This t2 r2 =
    This (liftF2 (<.>) t1 t2) (liftF2 (liftF2 (<.>)) r1 r2)

instance (Monoid a, Applicative f) => Applicative (This f a) where
  pure a =
    This (pure (mempty, a)) (pure (pure (pure a)))
  This t1 r1 <*> This t2 r2 =
    This (liftA2 (<*>) t1 t2) (liftF2 (liftF2 (<*>)) r1 r2)

-- |
--
-- >>> swap (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [('x',"abc"),('y',"def")] Nothing
-- >>> swap (This [("abc", 'x'), ("def", 'y')] (Just (Left ("a":|[]))))
-- This [('x',"abc"),('y',"def")] Just (Right ("a" :| []))
-- >>> swap (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|[]))))
-- This [('x',"abc"),('y',"def")] Just (Left ('a' :| ""))
instance Functor f => Swap (This f) where
  swap (This t r) =
    This (fmap swap t) (fmap swap r)

class Functor f => Semialign f where
  align ::
    f a
    -> f b
    -> This f a b
  align =
    alignWith id id id
  alignWith ::
    ((a, b) -> (c, d))
    -> (a -> c)
    -> (b -> d)
    -> f a
    -> f b
    -> This f c d
  alignWith f g h t1 t2 =
    case align t1 t2 of
      This t r ->
        This (fmap f t) (fmap (bimap (fmap g) (fmap h)) r)
  {-# MINIMAL align | alignWith #-}
  alignWith' ::
    (a -> c)
    -> (b -> d)
    -> f a
    -> f b
    -> This f c d
  alignWith' f g =
    alignWith (bimap f g) f g

-- |
--
-- >>> align "abc" "def"
-- This [('a','d'),('b','e'),('c','f')] Nothing
-- >>> align "abc" "defghi"
-- This [('a','d'),('b','e'),('c','f')] Just (Right ('g' :| "hi"))
-- >>> align "abcdef" "ghi"
-- This [('a','g'),('b','h'),('c','i')] Just (Left ('d' :| "ef"))
instance Semialign [] where
  align (a:as) (b:bs) =
    let This t r = align as bs
    in  This ((a,b):t) r
  align (a:as) [] =
    This [] (Just (Left (a :| as)))
  align [] (b:bs) =
    This [] (Just (Right (b :| bs)))
  align [] [] =
    This [] Nothing

-- |
--
-- >>> align (Just "x") (Just "y")
-- This (Just ("x","y")) Nothing
-- >>> align (Just "x") (Nothing :: Maybe String)
-- This Nothing Just (Left ("x" :| []))
-- >>> align (Nothing :: Maybe String) (Just "y")
-- This Nothing Just (Right ("y" :| []))
instance Semialign Maybe where
  align (Just a) (Just b) =
    This (Just (a, b)) Nothing
  align (Just a) Nothing =
    This Nothing (Just (Left (a :| [])))
  align Nothing (Just b) =
    This Nothing (Just (Right (b :| [])))
  align Nothing Nothing =
    This Nothing Nothing

-- |
--
-- >>> align (Identity "x") (Identity "y")
-- This (Identity ("x","y")) Nothing
instance Semialign Identity where
  align (Identity a) (Identity b) =
    This (Identity (a, b)) Nothing

-- |
--
-- >>> align ('a':|"bc") ('g':|"hi")
-- This (('a','g') :| [('b','h'),('c','i')]) Nothing
-- >>> align ('a':|"bc") ('g':|"hijkl")
-- This (('a','g') :| [('b','h'),('c','i')]) Just (Right ('j' :| "kl"))
-- >>> align ('a':|"bcdef") ('g':|"hi")
-- This (('a','g') :| [('b','h'),('c','i')]) Just (Left ('d' :| "ef"))
instance Semialign NonEmpty where
  align (h1:|[]) (h2:|[]) =
    This ((h1, h2):|[]) Nothing
  align (h1:|i1:r1) (h2:|[]) =
    This ((h1, h2):|[]) (Just (Left (i1:|r1)))
  align (h1:|[]) (h2:|i2:r2) =
    This ((h1, h2):|[]) (Just (Right (i2:|r2)))
  align (h1:|i1:r1) (h2:|i2:r2) =
    let This t r = align (i1:|r1) (i2:|r2)
    in  This ((h1, h2) `NonEmpty.cons` t) r

instance Semialign ZipList where
  align (ZipList a) (ZipList b) =
    over these ZipList (align a b)

class Semialign f => Align f where
  nil ::
    f a

instance Align [] where
  nil =
    []

instance Align Maybe where
  nil =
    Nothing

instance Align ZipList where
  nil =
    ZipList []

-- |
--
-- >>> This [("abc", 's'), ("def", 't')] Nothing <> This [("ghi", 'u'), ("jkl", 'v')] Nothing
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Nothing
-- >>> This [("abc", 's'), ("def", 't')] Nothing <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Left ("mno":|["pqr"])))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Left ("mno" :| ["pqr"]))
-- >>> This [("abc", 's'), ("def", 't')] Nothing <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Right ('o':|"pqr")))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Right ('o' :| "pqr"))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Left ("mno":|["pqr"]))) <> This [("ghi", 'u'), ("jkl", 'v')] Nothing
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Left ("mno" :| ["pqr"]))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Right ('o':|"pqr"))) <> This [("ghi", 'u'), ("jkl", 'v')] Nothing
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Right ('o' :| "pqr"))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Left ("mno":|["pqr"]))) <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Left ("ccddee":|["ffgghh"])))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Left ("mno" :| ["pqr","ccddee","ffgghh"]))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Left ("mno":|["pqr"]))) <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Right ('c':|"ddeeff")))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v'),("mno",'c'),("pqr",'d')] Just (Right ('d' :| "eeff"))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Right ('x':|"yyzz"))) <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Right ('c':|"ddeeff")))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v')] Just (Right ('x' :| "yyzzcddeeff"))
-- >>> This [("abc", 's'), ("def", 't')] (Just (Right ('x':|"yyzz"))) <> This [("ghi", 'u'), ("jkl", 'v')] (Just (Left ("cc":|["ddeeff"])))
-- This [("abc",'s'),("def",'t'),("ghi",'u'),("jkl",'v'),("cc",'x'),("ddeeff",'y')] Just (Right ('y' :| "zz"))
instance Semigroup (This [] a b) where
  This t1 (Just (Left as1)) <> This t2 (Just (Left as2)) =
    This (t1 <> t2) (Just (Left (as1 <> as2)))
  This t1 (Just (Left as1)) <> This t2 (Just (Right bs2)) =
    over these (\x -> t1 <> t2 <> NonEmpty.toList x) (align as1 bs2)
  This t1 (Just (Left as1)) <> This t2 Nothing =
    This (t1 <> t2) (Just (Left as1))
  This t1 (Just (Right bs1)) <> This t2 (Just (Right bs2)) =
    This (t1 <> t2) (Just (Right (bs1 <> bs2)))
  This t1 (Just (Right bs1)) <> This t2 (Just (Left as2)) =
    over these (\x -> t1 <> t2 <> NonEmpty.toList x) (align as2 bs1)
  This t1 (Just (Right bs1)) <> This t2 Nothing =
    This (t1 <> t2) (Just (Right bs1))
  This t1 Nothing <> This t2 (Just (Left as2)) =
    This (t1 <> t2) (Just (Left as2))
  This t1 Nothing <> This t2 (Just (Right bs2)) =
    This (t1 <> t2) (Just (Right bs2))
  This t1 Nothing <> This t2 Nothing =
    This (t1 <> t2) Nothing

instance Semigroup (This NonEmpty a b) where
  This t1 (Just (Left as1)) <> This t2 (Just (Left as2)) =
    This (t1 <> t2) (Just (Left (as1 <> as2)))
  This t1 (Just (Left as1)) <> This t2 (Just (Right bs2)) =
    over these (\x -> t1 <> t2 <> x) (align as1 bs2)
  This t1 (Just (Left as1)) <> This t2 Nothing =
    This (t1 <> t2) (Just (Left as1))
  This t1 (Just (Right bs1)) <> This t2 (Just (Right bs2)) =
    This (t1 <> t2) (Just (Right (bs1 <> bs2)))
  This t1 (Just (Right bs1)) <> This t2 (Just (Left as2)) =
    over these (\x -> t1 <> t2 <> x) (align as2 bs1)
  This t1 (Just (Right bs1)) <> This t2 Nothing =
    This (t1 <> t2) (Just (Right bs1))
  This t1 Nothing <> This t2 (Just (Left as2)) =
    This (t1 <> t2) (Just (Left as2))
  This t1 Nothing <> This t2 (Just (Right bs2)) =
    This (t1 <> t2) (Just (Right bs2))
  This t1 Nothing <> This t2 Nothing =
    This (t1 <> t2) Nothing

instance Monoid (This [] a b) where
  mempty =
    This mempty Nothing

-- |
--
-- >>> over these reverse (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("def",'y'),("abc",'x')] Nothing
-- >>> over these reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("ghi":|["jkl"]))))
-- This [("def",'y'),("abc",'x')] Just (Left ("ghi" :| ["jkl"]))
these ::
  Lens
    (This f a b)
    (This f' a b)
    (f (a, b))
    (f' (a, b))
these f (This t r) =
  fmap (`This` r) (f t)

-- |
--
-- >>> over those (fmap (bimap (fmap reverse) (fmap Data.Char.toUpper))) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over those (fmap (bimap (fmap reverse) (fmap Data.Char.toUpper))) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("cba" :| ["fed"]))
-- >>> over those (fmap (bimap (fmap reverse) (fmap Data.Char.toUpper))) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('A' :| "BCDE"))
-- >>> Control.Lens.view those (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Nothing
-- >>> Control.Lens.view those (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just (Left ("abc" :| ["def"]))
-- >>> Control.Lens.view those (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just (Right ('a' :| "bcde"))
those ::
  Lens'
    (This f a b)
    (Maybe (Either (NonEmpty a) (NonEmpty b)))
those f (This t r) =
  fmap (This t) (f r)

-- |
--
-- >>> over allThese (bimap reverse Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("cba",'X'),("fed",'Y')] Nothing
-- >>> over allThese (bimap reverse Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("cba",'X'),("fed",'Y')] Just (Left ("abc" :| ["def"]))
-- >>> over allThese (bimap reverse Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("cba",'X'),("fed",'Y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allThese (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just ("abc",'x')
-- >>> Control.Lens.preview allThese (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just ("abc",'x')
-- >>> Control.Lens.preview allThese (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just ("abc",'x')
allThese ::
  Traversable f =>
  Traversal'
    (This f a b)
    (a, b)
allThese =
  these . traverse

-- |
--
-- >>> over allThese1 reverse (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("cba",'x'),("fed",'y')] Nothing
-- >>> over allThese1 reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("cba",'x'),("fed",'y')] Just (Left ("abc" :| ["def"]))
-- >>> over allThese1 reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("cba",'x'),("fed",'y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allThese1 (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just "abc"
-- >>> Control.Lens.preview allThese1 (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just "abc"
-- >>> Control.Lens.preview allThese1 (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just "abc"
allThese1 ::
  Traversable f =>
  Traversal'
    (This f a b)
    a
allThese1 =
  allThese . _1

-- |
--
-- >>> over allThese2 Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'X'),("def",'Y')] Nothing
-- >>> over allThese2 Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'X'),("def",'Y')] Just (Left ("abc" :| ["def"]))
-- >>> over allThese2 Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'X'),("def",'Y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allThese2 (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just 'x'
-- >>> Control.Lens.preview allThese2 (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just 'x'
-- >>> Control.Lens.preview allThese2 (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just 'x'
allThese2 ::
  Traversable f =>
  Traversal'
    (This f a b)
    b
allThese2 =
  allThese . _2

-- |
--
-- >>> over allThose (bimap (fmap reverse) (fmap Data.Char.toUpper)) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over allThose (bimap (fmap reverse) (fmap Data.Char.toUpper)) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("cba" :| ["fed"]))
-- >>> over allThose (bimap (fmap reverse) (fmap Data.Char.toUpper)) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('A' :| "BCDE"))
-- >>> Control.Lens.preview allThose (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Nothing
-- >>> Control.Lens.preview allThose (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just (Left ("abc" :| ["def"]))
-- >>> Control.Lens.preview allThose (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just (Right ('a' :| "bcde"))
allThose ::
  Traversal'
    (This f a b)
    (Either (NonEmpty a) (NonEmpty b))
allThose =
  those . _Just

-- |
--
-- >>> over allThoseA (fmap reverse) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over allThoseA (fmap reverse) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("cba" :| ["fed"]))
-- >>> over allThoseA (fmap reverse) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allThoseA (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Nothing
-- >>> Control.Lens.preview allThoseA (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just ("abc" :| ["def"])
-- >>> Control.Lens.preview allThoseA (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Nothing
allThoseA ::
  Traversal'
    (This f a b)
    (NonEmpty a)
allThoseA =
  allThose . _Left

-- |
--
-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("def" :| ["abc"]))
-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just []
-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just ["abc","def"]
-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Nothing
allThoseAOr ::
  Traversal'
    (This f a b)
    [a]
allThoseAOr f (This t Nothing) =
  This t <$> (Nothing <$ f [])
allThoseAOr _ th@(This _ (Just (Right _))) =
  pure th
allThoseAOr f (This t (Just (Left a))) =
  let lst [] = Nothing
      lst (x:y) = Just (x:|y)
  in  This t . fmap Left . lst <$> f (NonEmpty.toList a)

-- |
--
-- >>> over allThoseB (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over allThoseB (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("abc" :| ["def"]))
-- >>> over allThoseB (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('A' :| "BCDE"))
-- >>> Control.Lens.preview allThoseB (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Nothing
-- >>> Control.Lens.preview allThoseB (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Nothing
-- >>> Control.Lens.preview allThoseB (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just ('a' :| "bcde")
allThoseB ::
  Traversal'
    (This f a b)
    (NonEmpty b)
allThoseB =
  allThose . _Right

-- |
--
-- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'x'),("def",'y')] Nothing
-- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'x'),("def",'y')] Just (Left ("abc" :| ["def"]))
-- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'x'),("def",'y')] Just (Right ('e' :| "dcba"))
-- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just ""
-- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Nothing
-- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just "abcde"
allThoseBOr ::
  Traversal'
    (This f a b)
    [b]
allThoseBOr f (This t Nothing) =
  This t <$> (Nothing <$ f [])
allThoseBOr f (This t (Just (Right b))) =
  let lst [] = Nothing
      lst (x:y) = Just (x:|y)
  in  This t . fmap Right . lst <$> f (NonEmpty.toList b)
allThoseBOr _ th@(This _ (Just (Left _))) =
  pure th

-- |
--
-- >>> over allTheseThoseA (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("ABC",'x'),("DEF",'y')] Nothing
-- >>> over allTheseThoseA (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("ABC",'x'),("DEF",'y')] Just (Left ("ABC" :| ["DEF"]))
-- >>> over allTheseThoseA (fmap Data.Char.toUpper) (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("ABC",'x'),("DEF",'y')] Just (Right ('a' :| "bcde"))
-- >>> Control.Lens.preview allTheseThoseA (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just "abc"
-- >>> Control.Lens.preview allTheseThoseA (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just "abc"
-- >>> Control.Lens.preview allTheseThoseA (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just "abc"
allTheseThoseA ::
  Traversable f =>
  Traversal
    (This f a b)
    (This f a' b)
    a
    a'
allTheseThoseA f (This t r) =
  let th =
        case r of
          Nothing ->
            pure Nothing
          Just (Left as) ->
            Just . Left <$> traverse f as
          Just (Right bs) ->
            pure (Just (Right bs))
  in  This <$>
        traverse (\(a, b) -> (, b) <$> f a) t <*> th

allTheseThoseA1 ::
  Traversable1 f =>
  Traversal1
    (This f a b)
    (This f a' b)
    a
    a'
allTheseThoseA1 f (This t r) =
  let x = This <$> traverse1 (\(a, b) -> (, b) <$> f a) t
  in  maybe
        ((\k -> k Nothing) <$> x)
        (
          either
            ((\p -> (\k -> k . Just . Left) <$> x <.> p) . traverse1 f)
             (\z -> (\k -> k (Just (Right z))) <$> x))
        r

-- |
--
-- >>> over allTheseThoseB Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] Nothing)
-- This [("abc",'X'),("def",'Y')] Nothing
-- >>> over allTheseThoseB Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- This [("abc",'X'),("def",'Y')] Just (Left ("abc" :| ["def"]))
-- >>> over allTheseThoseB Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- This [("abc",'X'),("def",'Y')] Just (Right ('A' :| "BCDE"))
-- >>> Control.Lens.preview allTheseThoseB (This [("abc", 'x'), ("def", 'y')] Nothing)
-- Just 'x'
-- >>> Control.Lens.preview allTheseThoseB (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))
-- Just 'x'
-- >>> Control.Lens.preview allTheseThoseB (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))
-- Just 'x'
allTheseThoseB ::
  Traversable f =>
  Traversal
    (This f a b)
    (This f a b')
    b
    b'
allTheseThoseB f (This t r) =
  let th =
        case r of
          Nothing ->
            pure Nothing
          Just (Left as) ->
            pure (Just (Left as))
          Just (Right bs) ->
            Just . Right <$> traverse f bs
  in  This <$>
        traverse (\(a, b) -> (a ,) <$> f b) t <*> th

allTheseThoseB1 ::
  Traversable1 f =>
  Traversal1
    (This f a b)
    (This f a b')
    b
    b'
allTheseThoseB1 f (This t r) =
  let x = This <$> traverse1 (\(a, b) -> (a ,) <$> f b) t
  in  maybe
        ((\k -> k Nothing) <$> x)
        (either
          (\z -> (\k -> k (Just (Left z))) <$> x)
          ((\p -> (\k -> k . Just . Right) <$> x <.> p) . traverse1 f))
          r