alignment (empty) → 0.1.0.0
raw patch · 5 files changed
+659/−0 lines, 5 filesdep +assocdep +basedep +bifunctorssetup-changed
Dependencies added: assoc, base, bifunctors, lens, semigroupoids, transformers
Files
- LICENCE +30/−0
- Setup.hs +2/−0
- alignment.cabal +39/−0
- changelog.md +4/−0
- src/Data/Alignment.hs +584/−0
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright (c) 2022 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of QFPL nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ alignment.cabal view
@@ -0,0 +1,39 @@+-- documentation, see http://haskell.org/cabal/users-guide/++name: alignment+version: 0.1.0.0+synopsis: Zip-alignment+description:+ <<https://system-f.gitlab.io/logo/systemf-450x450.jpg>>+ .+ Zipping with alignment+license: BSD3+license-file: LICENCE+author: Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer: Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright: Copyright (C) 2022 Tony Morris+category: Data+build-type: Simple+extra-source-files: changelog.md+cabal-version: >=1.10+homepage: https://github.com/system-f/alignment+bug-reports: https://github.com/system-f/alignment/issues+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1++source-repository head+ type: git+ location: git@github.com:system-f/alignment.git++library+ exposed-modules: Data.Alignment++ build-depends: base >= 4.8 && < 6+ , bifunctors >= 5 && < 6+ , lens >= 4.15 && < 6+ , semigroupoids >= 5.1 && < 5.4+ , transformers >= 0.5.0 && < 5.5+ , assoc >= 1 && < 2++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall
+ changelog.md view
@@ -0,0 +1,4 @@+0.1.0.0++* This change log starts.+* The initial version of alignment.
+ src/Data/Alignment.hs view
@@ -0,0 +1,584 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Alignment(+-- * Types+ This(..)+-- * Type-classes+, Semialign(..)+, Align(..)+-- * Optics+, these+, those+, allThese+, allThese1+, allThese2+, allThose+, allThoseA+, allThoseA'+, allThoseB+, allThoseB'+, allTheseThoseA+, allTheseThoseB+) where++import Control.Applicative+ ( Applicative(liftA2, pure, (<*>)), (<$>), ZipList(ZipList) )+import Control.Category ( Category((.)) )+import Control.Lens+ ( Identity(Identity),+ _Just,+ _Left,+ _Right,+ over,+ Field1(_1),+ Field2(_2),+ Lens,+ Lens',+ Traversal' )+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(..) )+import Data.Eq ( Eq((==)) )+import Data.Foldable ( Foldable(foldMap) )+import Data.Functor ( Functor(fmap) )+import Data.Functor.Apply ( Apply((<.>), liftF2) )+import qualified Data.List.NonEmpty as NonEmpty(cons, toList)+import Data.Maybe ( Maybe(..) )+import Data.Monoid ( (<>), Monoid(mempty) )+import Data.Ord ( Ord(compare) )+import Data.Semigroup ( Semigroup )+import Data.Traversable ( Traversable(traverse) )+import GHC.Show ( Show(showsPrec) )+import Data.Functor.Classes+ ( compare1,+ eq1,+ showsPrec1,+ showsUnaryWith,+ Eq1(..),+ Ord1(..),+ Show1(..) )++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 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 Functor f => Functor (This f a) where+ fmap =+ bimap (\x -> x)++-- |+--+-- >>> 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 "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 (\t' -> This t' 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 (\r' -> This t r') (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 allThoseA' reverse (This [("abc", 'x'), ("def", 'y')] Nothing)+-- This [("abc",'x'),("def",'y')] Nothing+-- >>> over allThoseA' reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))+-- This [("abc",'x'),("def",'y')] Just (Left ("cba" :| ["fed"]))+-- >>> over allThoseA' 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"+-- >>> Control.Lens.preview allThoseA' (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))+-- Nothing+allThoseA' ::+ Traversable f =>+ Traversal'+ (This f a b)+ a+allThoseA' =+ allThoseA . traverse++-- |+--+-- >>> 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 allThoseB' Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] Nothing)+-- This [("abc",'x'),("def",'y')] Nothing+-- >>> over allThoseB' Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))+-- This [("abc",'x'),("def",'y')] Just (Left ("abc" :| ["def"]))+-- >>> over allThoseB' 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'+allThoseB' ::+ Traversable f =>+ Traversal'+ (This f a b)+ b+allThoseB' =+ allThoseB . traverse++-- |+--+-- >>> 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)+ 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++-- |+--+-- >>> 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)+ 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