{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.Alignment(
This(..)
, Semialign(..)
, Align(..)
, 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) )
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 f (a, b)
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
r1 == :: This f a b -> This f a b -> Bool
== This f (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
r2 =
f (a, b)
t1 forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
`eq1` f (a, b)
t2 Bool -> Bool -> Bool
&& Maybe (Either (NonEmpty a) (NonEmpty b))
r1 forall a. Eq a => a -> a -> Bool
== Maybe (Either (NonEmpty a) (NonEmpty b))
r2
instance (Eq1 f, Eq a) => Eq1 (This f a) where
liftEq :: forall a b. (a -> b -> Bool) -> This f a a -> This f a b -> Bool
liftEq a -> b -> Bool
f (This f (a, a)
t1 Maybe (Either (NonEmpty a) (NonEmpty a))
r1) (This f (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
r2) =
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f) f (a, a)
t1 f (a, b)
t2 Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f)) Maybe (Either (NonEmpty a) (NonEmpty a))
r1 Maybe (Either (NonEmpty a) (NonEmpty b))
r2
instance (Ord1 f, Ord a, Ord b) => Ord (This f a b) where
This f (a, b)
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
r1 compare :: This f a b -> This f a b -> Ordering
`compare` This f (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
r2 =
f (a, b)
t1 forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
`compare1` f (a, b)
t2 forall a. Semigroup a => a -> a -> a
<> Maybe (Either (NonEmpty a) (NonEmpty b))
r1 forall a. Ord a => a -> a -> Ordering
`compare` Maybe (Either (NonEmpty a) (NonEmpty b))
r2
instance (Ord1 f, Ord a) => Ord1 (This f a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> This f a a -> This f a b -> Ordering
liftCompare a -> b -> Ordering
f (This f (a, a)
t1 Maybe (Either (NonEmpty a) (NonEmpty a))
r1) (This f (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
r2) =
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f) f (a, a)
t1 f (a, b)
t2 forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f)) Maybe (Either (NonEmpty a) (NonEmpty a))
r1 Maybe (Either (NonEmpty a) (NonEmpty b))
r2
instance (Show1 f, Show a, Show b) => Show (This f a b) where
showsPrec :: Int -> This f a b -> ShowS
showsPrec Int
d (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 String
"This" Int
d f (a, b)
t forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String
" " forall a. Semigroup a => a -> a -> a
<>) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
d Maybe (Either (NonEmpty a) (NonEmpty b))
r
instance (Show1 f, Show a) => Show1 (This f a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> This f a a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (This f (a, a)
t Maybe (Either (NonEmpty a) (NonEmpty a))
r) =
let showsPrecFt :: Int -> f (a, a) -> ShowS
showsPrecFt = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl)
showsPrecFr :: Int -> Maybe (Either (NonEmpty a) (NonEmpty a)) -> ShowS
showsPrecFr = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl)) (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl))
in forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> f (a, a) -> ShowS
showsPrecFt String
"This" Int
d f (a, a)
t forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String
" " forall a. Semigroup a => a -> a -> a
<>) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Maybe (Either (NonEmpty a) (NonEmpty a)) -> ShowS
showsPrecFr Int
d Maybe (Either (NonEmpty a) (NonEmpty a))
r
instance Functor f => Bifunctor (This f) where
bimap :: forall a b c d. (a -> b) -> (c -> d) -> This f a c -> This f b d
bimap a -> b
f c -> d
g (This f (a, c)
t Maybe (Either (NonEmpty a) (NonEmpty c))
r) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) f (a, c)
t) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g)) Maybe (Either (NonEmpty a) (NonEmpty c))
r)
instance Foldable f => Bifoldable (This f) where
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> This f a b -> m
bifoldMap a -> m
f b -> m
g (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) f (a, b)
t forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g)) Maybe (Either (NonEmpty a) (NonEmpty b))
r
instance Traversable f => Bitraversable (This f) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> This f a b -> f (This f c d)
bitraverse a -> f c
f b -> f d
g (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) f (a, b)
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g)) Maybe (Either (NonEmpty a) (NonEmpty b))
r
instance Functor f => Functor (This f a) where
fmap :: forall a b. (a -> b) -> This f a a -> This f a b
fmap =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\a
x -> a
x)
instance (Semigroup a, Apply f) => Apply (This f a) where
This f (a, a -> b)
t1 Maybe (Either (NonEmpty a) (NonEmpty (a -> b)))
r1 <.> :: forall a b. This f a (a -> b) -> This f a a -> This f a b
<.> This f (a, a)
t2 Maybe (Either (NonEmpty a) (NonEmpty a))
r2 =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) f (a, a -> b)
t1 f (a, a)
t2) (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)) Maybe (Either (NonEmpty a) (NonEmpty (a -> b)))
r1 Maybe (Either (NonEmpty a) (NonEmpty a))
r2)
instance (Monoid a, Applicative f) => Applicative (This f a) where
pure :: forall a. a -> This f a a
pure a
a =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => a
mempty, a
a)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)))
This f (a, a -> b)
t1 Maybe (Either (NonEmpty a) (NonEmpty (a -> b)))
r1 <*> :: forall a b. This f a (a -> b) -> This f a a -> This f a b
<*> This f (a, a)
t2 Maybe (Either (NonEmpty a) (NonEmpty a))
r2 =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) f (a, a -> b)
t1 f (a, a)
t2) (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 (forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
liftF2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)) Maybe (Either (NonEmpty a) (NonEmpty (a -> b)))
r1 Maybe (Either (NonEmpty a) (NonEmpty a))
r2)
instance Functor f => Swap (This f) where
swap :: forall a b. This f a b -> This f b a
swap (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap f (a, b)
t) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap Maybe (Either (NonEmpty a) (NonEmpty b))
r)
class Functor f => Semialign f where
align ::
f a
-> f b
-> This f a b
align =
forall (f :: * -> *) a b c d.
Semialign f =>
((a, b) -> (c, d))
-> (a -> c) -> (b -> d) -> f a -> f b -> This f c d
alignWith (\(a, b)
x -> (a, b)
x) (\a
x -> a
x) (\b
x -> b
x)
alignWith ::
((a, b) -> (c, d))
-> (a -> c)
-> (b -> d)
-> f a
-> f b
-> This f c d
alignWith (a, b) -> (c, d)
f a -> c
g b -> d
h f a
t1 f b
t2 =
case forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align f a
t1 f b
t2 of
This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r ->
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> (c, d)
f f (a, b)
t) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> c
g) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> d
h)) Maybe (Either (NonEmpty a) (NonEmpty b))
r)
{-# MINIMAL align | alignWith #-}
alignWith' ::
(a -> c)
-> (b -> d)
-> f a
-> f b
-> This f c d
alignWith' a -> c
f b -> d
g =
forall (f :: * -> *) a b c d.
Semialign f =>
((a, b) -> (c, d))
-> (a -> c) -> (b -> d) -> f a -> f b -> This f c d
alignWith (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> c
f b -> d
g) a -> c
f b -> d
g
instance Semialign [] where
align :: forall a b. [a] -> [b] -> This [] a b
align (a
a:[a]
as) (b
b:[b]
bs) =
let This [(a, b)]
t Maybe (Either (NonEmpty a) (NonEmpty b))
r = forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align [a]
as [b]
bs
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ((a
a,b
b)forall a. a -> [a] -> [a]
:[(a, b)]
t) Maybe (Either (NonEmpty a) (NonEmpty b))
r
align (a
a:[a]
as) [] =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This [] (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (a
a forall a. a -> [a] -> NonEmpty a
:| [a]
as)))
align [] (b
b:[b]
bs) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This [] (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (b
b forall a. a -> [a] -> NonEmpty a
:| [b]
bs)))
align [] [] =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This [] forall a. Maybe a
Nothing
instance Semialign Maybe where
align :: forall a b. Maybe a -> Maybe b -> This Maybe a b
align (Just a
a) (Just b
b) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall a. a -> Maybe a
Just (a
a, b
b)) forall a. Maybe a
Nothing
align (Just a
a) Maybe b
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (a
a forall a. a -> [a] -> NonEmpty a
:| [])))
align Maybe a
Nothing (Just b
b) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (b
b forall a. a -> [a] -> NonEmpty a
:| [])))
align Maybe a
Nothing Maybe b
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall a. Maybe a
Nothing forall a. Maybe a
Nothing
instance Semialign Identity where
align :: forall a b. Identity a -> Identity b -> This Identity a b
align (Identity a
a) (Identity b
b) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (forall a. a -> Identity a
Identity (a
a, b
b)) forall a. Maybe a
Nothing
instance Semialign NonEmpty where
align :: forall a b. NonEmpty a -> NonEmpty b -> This NonEmpty a b
align (a
h1:|[]) (b
h2:|[]) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ((a
h1, b
h2)forall a. a -> [a] -> NonEmpty a
:|[]) forall a. Maybe a
Nothing
align (a
h1:|a
i1:[a]
r1) (b
h2:|[]) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ((a
h1, b
h2)forall a. a -> [a] -> NonEmpty a
:|[]) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (a
i1forall a. a -> [a] -> NonEmpty a
:|[a]
r1)))
align (a
h1:|[]) (b
h2:|b
i2:[b]
r2) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ((a
h1, b
h2)forall a. a -> [a] -> NonEmpty a
:|[]) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (b
i2forall a. a -> [a] -> NonEmpty a
:|[b]
r2)))
align (a
h1:|a
i1:[a]
r1) (b
h2:|b
i2:[b]
r2) =
let This NonEmpty (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r = forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align (a
i1forall a. a -> [a] -> NonEmpty a
:|[a]
r1) (b
i2forall a. a -> [a] -> NonEmpty a
:|[b]
r2)
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ((a
h1, b
h2) forall a. a -> NonEmpty a -> NonEmpty a
`NonEmpty.cons` NonEmpty (a, b)
t) Maybe (Either (NonEmpty a) (NonEmpty b))
r
instance Semialign ZipList where
align :: forall a b. ZipList a -> ZipList b -> This ZipList a b
align (ZipList [a]
a) (ZipList [b]
b) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these forall a. [a] -> ZipList a
ZipList (forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align [a]
a [b]
b)
class Semialign f => Align f where
nil ::
f a
instance Align [] where
nil :: forall a. [a]
nil =
[]
instance Align Maybe where
nil :: forall a. Maybe a
nil =
forall a. Maybe a
Nothing
instance Align ZipList where
nil :: forall a. ZipList a
nil =
forall a. [a] -> ZipList a
ZipList []
instance Semigroup (This [] a b) where
This [(a, b)]
t1 (Just (Left NonEmpty a
as1)) <> :: This [] a b -> This [] a b -> This [] a b
<> This [(a, b)]
t2 (Just (Left NonEmpty a
as2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (NonEmpty a
as1 forall a. Semigroup a => a -> a -> a
<> NonEmpty a
as2)))
This [(a, b)]
t1 (Just (Left NonEmpty a
as1)) <> This [(a, b)]
t2 (Just (Right NonEmpty b
bs2)) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these (\NonEmpty (a, b)
x -> [(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2 forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (a, b)
x) (forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align NonEmpty a
as1 NonEmpty b
bs2)
This [(a, b)]
t1 (Just (Left NonEmpty a
as1)) <> This [(a, b)]
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NonEmpty a
as1))
This [(a, b)]
t1 (Just (Right NonEmpty b
bs1)) <> This [(a, b)]
t2 (Just (Right NonEmpty b
bs2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (NonEmpty b
bs1 forall a. Semigroup a => a -> a -> a
<> NonEmpty b
bs2)))
This [(a, b)]
t1 (Just (Right NonEmpty b
bs1)) <> This [(a, b)]
t2 (Just (Left NonEmpty a
as2)) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these (\NonEmpty (a, b)
x -> [(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2 forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (a, b)
x) (forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align NonEmpty a
as2 NonEmpty b
bs1)
This [(a, b)]
t1 (Just (Right NonEmpty b
bs1)) <> This [(a, b)]
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right NonEmpty b
bs1))
This [(a, b)]
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This [(a, b)]
t2 (Just (Left NonEmpty a
as2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NonEmpty a
as2))
This [(a, b)]
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This [(a, b)]
t2 (Just (Right NonEmpty b
bs2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right NonEmpty b
bs2))
This [(a, b)]
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This [(a, b)]
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This ([(a, b)]
t1 forall a. Semigroup a => a -> a -> a
<> [(a, b)]
t2) forall a. Maybe a
Nothing
instance Semigroup (This NonEmpty a b) where
This NonEmpty (a, b)
t1 (Just (Left NonEmpty a
as1)) <> :: This NonEmpty a b -> This NonEmpty a b -> This NonEmpty a b
<> This NonEmpty (a, b)
t2 (Just (Left NonEmpty a
as2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (NonEmpty a
as1 forall a. Semigroup a => a -> a -> a
<> NonEmpty a
as2)))
This NonEmpty (a, b)
t1 (Just (Left NonEmpty a
as1)) <> This NonEmpty (a, b)
t2 (Just (Right NonEmpty b
bs2)) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these (\NonEmpty (a, b)
x -> NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
x) (forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align NonEmpty a
as1 NonEmpty b
bs2)
This NonEmpty (a, b)
t1 (Just (Left NonEmpty a
as1)) <> This NonEmpty (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NonEmpty a
as1))
This NonEmpty (a, b)
t1 (Just (Right NonEmpty b
bs1)) <> This NonEmpty (a, b)
t2 (Just (Right NonEmpty b
bs2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (NonEmpty b
bs1 forall a. Semigroup a => a -> a -> a
<> NonEmpty b
bs2)))
This NonEmpty (a, b)
t1 (Just (Right NonEmpty b
bs1)) <> This NonEmpty (a, b)
t2 (Just (Left NonEmpty a
as2)) =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these (\NonEmpty (a, b)
x -> NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
x) (forall (f :: * -> *) a b. Semialign f => f a -> f b -> This f a b
align NonEmpty a
as2 NonEmpty b
bs1)
This NonEmpty (a, b)
t1 (Just (Right NonEmpty b
bs1)) <> This NonEmpty (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right NonEmpty b
bs1))
This NonEmpty (a, b)
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This NonEmpty (a, b)
t2 (Just (Left NonEmpty a
as2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NonEmpty a
as2))
This NonEmpty (a, b)
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This NonEmpty (a, b)
t2 (Just (Right NonEmpty b
bs2)) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right NonEmpty b
bs2))
This NonEmpty (a, b)
t1 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing <> This NonEmpty (a, b)
t2 Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This (NonEmpty (a, b)
t1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (a, b)
t2) forall a. Maybe a
Nothing
instance Monoid (This [] a b) where
mempty :: This [] a b
mempty =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
these ::
Lens
(This f a b)
(This f' a b)
(f (a, b))
(f' (a, b))
these :: forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these f (a, b) -> f (f' (a, b))
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f' (a, b)
t' -> forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f' (a, b)
t' Maybe (Either (NonEmpty a) (NonEmpty b))
r) (f (a, b) -> f (f' (a, b))
f f (a, b)
t)
those ::
Lens'
(This f a b)
(Maybe (Either (NonEmpty a) (NonEmpty b)))
those :: forall (f :: * -> *) a b.
Lens' (This f a b) (Maybe (Either (NonEmpty a) (NonEmpty b)))
those Maybe (Either (NonEmpty a) (NonEmpty b))
-> f (Maybe (Either (NonEmpty a) (NonEmpty b)))
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (Either (NonEmpty a) (NonEmpty b))
r' -> forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r') (Maybe (Either (NonEmpty a) (NonEmpty b))
-> f (Maybe (Either (NonEmpty a) (NonEmpty b)))
f Maybe (Either (NonEmpty a) (NonEmpty b))
r)
allThese ::
Traversable f =>
Traversal'
(This f a b)
(a, b)
allThese :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) (a, b)
allThese =
forall (f :: * -> *) a b (f' :: * -> *).
Lens (This f a b) (This f' a b) (f (a, b)) (f' (a, b))
these forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
allThese1 ::
Traversable f =>
Traversal'
(This f a b)
a
allThese1 :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) a
allThese1 =
forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) (a, b)
allThese forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
allThese2 ::
Traversable f =>
Traversal'
(This f a b)
b
allThese2 :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) b
allThese2 =
forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) (a, b)
allThese forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
allThose ::
Traversal'
(This f a b)
(Either (NonEmpty a) (NonEmpty b))
allThose :: forall (f :: * -> *) a b.
Traversal' (This f a b) (Either (NonEmpty a) (NonEmpty b))
allThose =
forall (f :: * -> *) a b.
Lens' (This f a b) (Maybe (Either (NonEmpty a) (NonEmpty b)))
those forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
allThoseA ::
Traversal'
(This f a b)
(NonEmpty a)
allThoseA :: forall (f :: * -> *) a b. Traversal' (This f a b) (NonEmpty a)
allThoseA =
forall (f :: * -> *) a b.
Traversal' (This f a b) (Either (NonEmpty a) (NonEmpty b))
allThose forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a c b. Prism (Either a c) (Either b c) a b
_Left
allThoseA' ::
Traversable f =>
Traversal'
(This f a b)
a
allThoseA' :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) a
allThoseA' =
forall (f :: * -> *) a b. Traversal' (This f a b) (NonEmpty a)
allThoseA forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
allThoseAOr ::
Traversal'
(This f a b)
[a]
allThoseAOr :: forall (f :: * -> *) a b. Traversal' (This f a b) [a]
allThoseAOr [a] -> f [a]
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f (a, b)
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [a] -> f [a]
f [])
allThoseAOr [a] -> f [a]
_ th :: This f a b
th@(This f (a, b)
_ (Just (Right NonEmpty b
_))) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure This f a b
th
allThoseAOr [a] -> f [a]
f (This f (a, b)
t (Just (Left NonEmpty a
a))) =
let lst :: [a] -> Maybe (NonEmpty a)
lst [] = forall a. Maybe a
Nothing
lst (a
x:[a]
y) = forall a. a -> Maybe a
Just (a
xforall a. a -> [a] -> NonEmpty a
:|[a]
y)
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f (a, b)
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {a}. [a] -> Maybe (NonEmpty a)
lst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> f [a]
f (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty a
a))
allThoseB ::
Traversal'
(This f a b)
(NonEmpty b)
allThoseB :: forall (f :: * -> *) a b. Traversal' (This f a b) (NonEmpty b)
allThoseB =
forall (f :: * -> *) a b.
Traversal' (This f a b) (Either (NonEmpty a) (NonEmpty b))
allThose forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall c a b. Prism (Either c a) (Either c b) a b
_Right
allThoseB' ::
Traversable f =>
Traversal'
(This f a b)
b
allThoseB' :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) b
allThoseB' =
forall (f :: * -> *) a b. Traversal' (This f a b) (NonEmpty b)
allThoseB forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
allThoseBOr ::
Traversal'
(This f a b)
[b]
allThoseBOr :: forall (f :: * -> *) a b. Traversal' (This f a b) [b]
allThoseBOr [b] -> f [b]
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing) =
forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f (a, b)
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [b] -> f [b]
f [])
allThoseBOr [b] -> f [b]
f (This f (a, b)
t (Just (Right NonEmpty b
b))) =
let lst :: [a] -> Maybe (NonEmpty a)
lst [] = forall a. Maybe a
Nothing
lst (a
x:[a]
y) = forall a. a -> Maybe a
Just (a
xforall a. a -> [a] -> NonEmpty a
:|[a]
y)
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This f (a, b)
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {a}. [a] -> Maybe (NonEmpty a)
lst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b] -> f [b]
f (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty b
b))
allThoseBOr [b] -> f [b]
_ th :: This f a b
th@(This f (a, b)
_ (Just (Left NonEmpty a
_))) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure This f a b
th
allTheseThoseA ::
Traversable f =>
Traversal'
(This f a b)
a
allTheseThoseA :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) a
allTheseThoseA a -> f a
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
let th :: f (Maybe (Either (NonEmpty a) (NonEmpty b)))
th =
case Maybe (Either (NonEmpty a) (NonEmpty b))
r of
Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just (Left NonEmpty a
as) ->
forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
f NonEmpty a
as
Just (Right NonEmpty b
bs) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right NonEmpty b
bs))
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(a
a, b
b) -> (, b
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a) f (a, b)
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe (Either (NonEmpty a) (NonEmpty b)))
th
allTheseThoseB ::
Traversable f =>
Traversal'
(This f a b)
b
allTheseThoseB :: forall (f :: * -> *) a b.
Traversable f =>
Traversal' (This f a b) b
allTheseThoseB b -> f b
f (This f (a, b)
t Maybe (Either (NonEmpty a) (NonEmpty b))
r) =
let th :: f (Maybe (Either (NonEmpty a) (NonEmpty b)))
th =
case Maybe (Either (NonEmpty a) (NonEmpty b))
r of
Maybe (Either (NonEmpty a) (NonEmpty b))
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just (Left NonEmpty a
as) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NonEmpty a
as))
Just (Right NonEmpty b
bs) ->
forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f b
f NonEmpty b
bs
in forall (f :: * -> *) a b.
f (a, b) -> Maybe (Either (NonEmpty a) (NonEmpty b)) -> This f a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(a
a, b
b) -> (a
a ,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b
f b
b) f (a, b)
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe (Either (NonEmpty a) (NonEmpty b)))
th