alignment-0.1.0.2: src/Data/Alignment.hs
{-# 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'
, allThoseAOr
, allThoseB
, allThoseB'
, allThoseBOr
, 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 Data.Functor.Classes
( compare1,
eq1,
showsPrec1,
showsUnaryWith,
Eq1(..),
Ord1(..),
Show1(..) )
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) )
-- $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 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 =
alignWith (\x -> x) (\x -> x)
alignWith ::
(a -> c)
-> (b -> d)
-> f a
-> f b
-> This f c d
alignWith f g a b =
bimap f g (align a b)
{-# MINIMAL align | alignWith #-}
-- |
--
-- >>> 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 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"
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 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 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)
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