{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
module Data.Semialign.Internal where
import Prelude ()
import Prelude.Compat hiding (repeat, unzip, zip, zipWith)
import qualified Prelude.Compat as Prelude
import Control.Applicative (ZipList (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Functor.Compose (Compose (..))
import Data.Functor.Identity (Identity (..))
import Data.Functor.Product (Product (..))
import Data.Hashable (Hashable (..))
import Data.HashMap.Strict (HashMap)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes)
import Data.Proxy (Proxy (..))
import Data.Semigroup (Option (..), Semigroup (..))
import Data.Sequence (Seq)
import Data.Tagged (Tagged (..))
import Data.Vector.Fusion.Stream.Monadic (Step (..), Stream (..))
import Data.Vector.Generic (Vector, empty, stream, unstream)
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NE
import qualified Data.Sequence as Seq
import qualified Data.Tree as T
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as Stream
#if MIN_VERSION_vector(0,11,0)
import Data.Vector.Fusion.Bundle.Monadic (Bundle (..))
import qualified Data.Vector.Fusion.Bundle.Monadic as Bundle
import qualified Data.Vector.Fusion.Bundle.Size as Bundle
#else
import qualified Data.Vector.Fusion.Stream.Size as Stream
#endif
#if MIN_VERSION_containers(0,5,0)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.IntMap.Lazy (IntMap)
import qualified Data.IntMap.Lazy as IntMap
#if MIN_VERSION_containers(0,5,9)
import qualified Data.IntMap.Merge.Lazy as IntMap
import qualified Data.Map.Merge.Lazy as Map
#endif
#else
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
#endif
import Data.These
import Data.These.Combinators
oops :: String -> a
oops :: String -> a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("Data.Align: internal error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
class Functor f => Semialign f where
align :: f a -> f b -> f (These a b)
align = (These a b -> These a b) -> f a -> f b -> f (These a b)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> These a b
forall a. a -> a
id
alignWith :: (These a b -> c) -> f a -> f b -> f c
alignWith f :: These a b -> c
f a :: f a
a b :: f b
b = These a b -> c
f (These a b -> c) -> f (These a b) -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f b -> f (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align f a
a f b
b
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL (align | alignWith) #-}
#endif
class Semialign f => Align f where
nil :: f a
class Semialign f => Unalign f where
unalign :: f (These a b) -> (f a, f b)
unalign = (These a b -> These a b) -> f (These a b) -> (f a, f b)
forall (f :: * -> *) c a b.
Unalign f =>
(c -> These a b) -> f c -> (f a, f b)
unalignWith These a b -> These a b
forall a. a -> a
id
unalignWith :: (c -> These a b) -> f c -> (f a, f b)
unalignWith f :: c -> These a b
f fx :: f c
fx = f (These a b) -> (f a, f b)
forall (f :: * -> *) a b. Unalign f => f (These a b) -> (f a, f b)
unalign ((c -> These a b) -> f c -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> These a b
f f c
fx)
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL unalignWith | unalign #-}
#endif
class Semialign f => Zip f where
zip :: f a -> f b -> f (a, b)
zip = (a -> b -> (a, b)) -> f a -> f b -> f (a, b)
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (,)
zipWith :: (a -> b -> c) -> f a -> f b -> f c
zipWith f :: a -> b -> c
f a :: f a
a b :: f b
b = (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f ((a, b) -> c) -> f (a, b) -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip f a
a f b
b
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL (zip | zipWith) #-}
#endif
class Zip f => Repeat f where
repeat :: a -> f a
class Zip f => Unzip f where
unzipWith :: (c -> (a, b)) -> f c -> (f a, f b)
unzipWith f :: c -> (a, b)
f = f (a, b) -> (f a, f b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip (f (a, b) -> (f a, f b)) -> (f c -> f (a, b)) -> f c -> (f a, f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> (a, b)) -> f c -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> (a, b)
f
unzip :: f (a, b) -> (f a, f b)
unzip = ((a, b) -> (a, b)) -> f (a, b) -> (f a, f b)
forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL unzipWith | unzip #-}
#endif
unzipDefault :: Functor f => f (a, b) -> (f a, f b)
unzipDefault :: f (a, b) -> (f a, f b)
unzipDefault x :: f (a, b)
x = ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> f (a, b) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
x, (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
x)
instance Semialign ((->) e) where
align :: (e -> a) -> (e -> b) -> e -> These a b
align f :: e -> a
f g :: e -> b
g x :: e
x = a -> b -> These a b
forall a b. a -> b -> These a b
These (e -> a
f e
x) (e -> b
g e
x)
alignWith :: (These a b -> c) -> (e -> a) -> (e -> b) -> e -> c
alignWith h :: These a b -> c
h f :: e -> a
f g :: e -> b
g x :: e
x = These a b -> c
h (a -> b -> These a b
forall a b. a -> b -> These a b
These (e -> a
f e
x) (e -> b
g e
x))
instance Zip ((->) e) where
zip :: (e -> a) -> (e -> b) -> e -> (a, b)
zip f :: e -> a
f g :: e -> b
g x :: e
x = (e -> a
f e
x, e -> b
g e
x)
instance Repeat ((->) e) where
repeat :: a -> e -> a
repeat = a -> e -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Semialign Maybe where
align :: Maybe a -> Maybe b -> Maybe (These a b)
align Nothing Nothing = Maybe (These a b)
forall a. Maybe a
Nothing
align (Just a :: a
a) Nothing = These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (a -> These a b
forall a b. a -> These a b
This a
a)
align Nothing (Just b :: b
b) = These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (b -> These a b
forall a b. b -> These a b
That b
b)
align (Just a :: a
a) (Just b :: b
b) = These a b -> Maybe (These a b)
forall a. a -> Maybe a
Just (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)
instance Zip Maybe where
zip :: Maybe a -> Maybe b -> Maybe (a, b)
zip Nothing _ = Maybe (a, b)
forall a. Maybe a
Nothing
zip (Just _) Nothing = Maybe (a, b)
forall a. Maybe a
Nothing
zip (Just a :: a
a) (Just b :: b
b) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b)
instance Repeat Maybe where
repeat :: a -> Maybe a
repeat = a -> Maybe a
forall a. a -> Maybe a
Just
instance Unalign Maybe where
unalign :: Maybe (These a b) -> (Maybe a, Maybe b)
unalign Nothing = (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
unalign (Just (This a :: a
a)) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe b
forall a. Maybe a
Nothing)
unalign (Just (That b :: b
b)) = (Maybe a
forall a. Maybe a
Nothing, b -> Maybe b
forall a. a -> Maybe a
Just b
b)
unalign (Just (These a :: a
a b :: b
b)) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a, b -> Maybe b
forall a. a -> Maybe a
Just b
b)
instance Unzip Maybe where
unzip :: Maybe (a, b) -> (Maybe a, Maybe b)
unzip = Maybe (a, b) -> (Maybe a, Maybe b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Align Maybe where
nil :: Maybe a
nil = Maybe a
forall a. Maybe a
Nothing
instance Semialign [] where
align :: [a] -> [b] -> [These a b]
align xs :: [a]
xs [] = a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> [a] -> [These a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
align [] ys :: [b]
ys = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> [b] -> [These a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b]
ys
align (x :: a
x:xs :: [a]
xs) (y :: b
y:ys :: [b]
ys) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y These a b -> [These a b] -> [These a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [These a b]
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align [a]
xs [b]
ys
instance Align [] where
nil :: [a]
nil = []
instance Zip [] where
zip :: [a] -> [b] -> [(a, b)]
zip = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith
instance Repeat [] where
repeat :: a -> [a]
repeat = a -> [a]
forall a. a -> [a]
Prelude.repeat
instance Unzip [] where
unzip :: [(a, b)] -> ([a], [b])
unzip = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
Prelude.unzip
instance Semialign ZipList where
alignWith :: (These a b -> c) -> ZipList a -> ZipList b -> ZipList c
alignWith f :: These a b -> c
f (ZipList xs :: [a]
xs) (ZipList ys :: [b]
ys) = [c] -> ZipList c
forall a. [a] -> ZipList a
ZipList ((These a b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f [a]
xs [b]
ys)
instance Align ZipList where
nil :: ZipList a
nil = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList []
instance Zip ZipList where
zipWith :: (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
zipWith f :: a -> b -> c
f (ZipList xs :: [a]
xs) (ZipList ys :: [b]
ys) = [c] -> ZipList c
forall a. [a] -> ZipList a
ZipList ((a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f [a]
xs [b]
ys)
instance Repeat ZipList where
repeat :: a -> ZipList a
repeat = a -> ZipList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Unzip ZipList where
unzip :: ZipList (a, b) -> (ZipList a, ZipList b)
unzip (ZipList xs :: [(a, b)]
xs) = ([a] -> ZipList a
forall a. [a] -> ZipList a
ZipList [a]
ys, [b] -> ZipList b
forall a. [a] -> ZipList a
ZipList [b]
zs) where
(ys :: [a]
ys, zs :: [b]
zs) = [(a, b)] -> ([a], [b])
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip [(a, b)]
xs
instance Semialign NonEmpty where
align :: NonEmpty a -> NonEmpty b -> NonEmpty (These a b)
align (x :: a
x :| xs :: [a]
xs) (y :: b
y :| ys :: [b]
ys) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y These a b -> [These a b] -> NonEmpty (These a b)
forall a. a -> [a] -> NonEmpty a
:| [a] -> [b] -> [These a b]
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align [a]
xs [b]
ys
instance Zip NonEmpty where
zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip = NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip
zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith = (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith
instance Repeat NonEmpty where
repeat :: a -> NonEmpty a
repeat = a -> NonEmpty a
forall a. a -> NonEmpty a
NE.repeat
instance Unzip NonEmpty where
unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
unzip = NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip
deriving instance Semialign Option
deriving instance Align Option
deriving instance Unalign Option
deriving instance Zip Option
deriving instance Repeat Option
deriving instance Unzip Option
instance Semialign Seq where
align :: Seq a -> Seq b -> Seq (These a b)
align xs :: Seq a
xs ys :: Seq b
ys = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
EQ -> (a -> b -> These a b) -> Seq a -> Seq b -> Seq (These a b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> These a b
forall a b. a -> b -> These a b
fc Seq a
xs Seq b
ys
LT -> case Int -> Seq b -> (Seq b, Seq b)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
xn Seq b
ys of
(ysl :: Seq b
ysl, ysr :: Seq b
ysr) -> (a -> b -> These a b) -> Seq a -> Seq b -> Seq (These a b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> These a b
forall a b. a -> b -> These a b
These Seq a
xs Seq b
ysl Seq (These a b) -> Seq (These a b) -> Seq (These a b)
forall a. Monoid a => a -> a -> a
`mappend` (b -> These a b) -> Seq b -> Seq (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> These a b
forall a b. b -> These a b
That Seq b
ysr
GT -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
yn Seq a
xs of
(xsl :: Seq a
xsl, xsr :: Seq a
xsr) -> (a -> b -> These a b) -> Seq a -> Seq b -> Seq (These a b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> These a b
forall a b. a -> b -> These a b
These Seq a
xsl Seq b
ys Seq (These a b) -> Seq (These a b) -> Seq (These a b)
forall a. Monoid a => a -> a -> a
`mappend` (a -> These a b) -> Seq a -> Seq (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a b
forall a b. a -> These a b
This Seq a
xsr
where
xn :: Int
xn = Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
xs
yn :: Int
yn = Seq b -> Int
forall a. Seq a -> Int
Seq.length Seq b
ys
fc :: a -> b -> These a b
fc = a -> b -> These a b
forall a b. a -> b -> These a b
These
alignWith :: (These a b -> c) -> Seq a -> Seq b -> Seq c
alignWith f :: These a b -> c
f xs :: Seq a
xs ys :: Seq b
ys = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
EQ -> (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> c
fc Seq a
xs Seq b
ys
LT -> case Int -> Seq b -> (Seq b, Seq b)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
xn Seq b
ys of
(ysl :: Seq b
ysl, ysr :: Seq b
ysr) -> (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> c
fc Seq a
xs Seq b
ysl Seq c -> Seq c -> Seq c
forall a. Monoid a => a -> a -> a
`mappend` (b -> c) -> Seq b -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f (These a b -> c) -> (b -> These a b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> These a b
forall a b. b -> These a b
That) Seq b
ysr
GT -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
yn Seq a
xs of
(xsl :: Seq a
xsl, xsr :: Seq a
xsr) -> (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> c
fc Seq a
xsl Seq b
ys Seq c -> Seq c -> Seq c
forall a. Monoid a => a -> a -> a
`mappend` (a -> c) -> Seq a -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f (These a b -> c) -> (a -> These a b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These a b
forall a b. a -> These a b
This) Seq a
xsr
where
xn :: Int
xn = Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
xs
yn :: Int
yn = Seq b -> Int
forall a. Seq a -> Int
Seq.length Seq b
ys
fc :: a -> b -> c
fc x :: a
x y :: b
y = These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y)
instance Align Seq where
nil :: Seq a
nil = Seq a
forall a. Seq a
Seq.empty
instance Unzip Seq where
#if MIN_VERSION_containers(0,5,11)
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip = Seq (a, b) -> (Seq a, Seq b)
forall a b. Seq (a, b) -> (Seq a, Seq b)
Seq.unzip
unzipWith :: (c -> (a, b)) -> Seq c -> (Seq a, Seq b)
unzipWith = (c -> (a, b)) -> Seq c -> (Seq a, Seq b)
forall c a b. (c -> (a, b)) -> Seq c -> (Seq a, Seq b)
Seq.unzipWith
#else
unzip = unzipDefault
#endif
instance Zip Seq where
zip :: Seq a -> Seq b -> Seq (a, b)
zip = Seq a -> Seq b -> Seq (a, b)
forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith
instance Semialign T.Tree where
align :: Tree a -> Tree b -> Tree (These a b)
align (T.Node x :: a
x xs :: Forest a
xs) (T.Node y :: b
y ys :: Forest b
ys) = These a b -> Forest (These a b) -> Tree (These a b)
forall a. a -> Forest a -> Tree a
T.Node (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y) ((These (Tree a) (Tree b) -> Tree (These a b))
-> Forest a -> Forest b -> Forest (These a b)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith ((Tree a -> Tree (These a b))
-> (Tree b -> Tree (These a b))
-> (Tree a -> Tree b -> Tree (These a b))
-> These (Tree a) (Tree b)
-> Tree (These a b)
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these ((a -> These a b) -> Tree a -> Tree (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> These a b
forall a b. a -> These a b
This) ((b -> These a b) -> Tree b -> Tree (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> These a b
forall a b. b -> These a b
That) Tree a -> Tree b -> Tree (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align) Forest a
xs Forest b
ys)
instance Zip T.Tree where
zipWith :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWith f :: a -> b -> c
f (T.Node x :: a
x xs :: Forest a
xs) (T.Node y :: b
y ys :: Forest b
ys) = c -> Forest c -> Tree c
forall a. a -> Forest a -> Tree a
T.Node (a -> b -> c
f a
x b
y) ((Tree a -> Tree b -> Tree c) -> Forest a -> Forest b -> Forest c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith ((a -> b -> c) -> Tree a -> Tree b -> Tree c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f) Forest a
xs Forest b
ys)
instance Repeat T.Tree where
repeat :: a -> Tree a
repeat x :: a
x = Tree a
n where n :: Tree a
n = a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
T.Node a
x (Tree a -> Forest a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat Tree a
n)
instance Unzip T.Tree where
unzipWith :: (c -> (a, b)) -> Tree c -> (Tree a, Tree b)
unzipWith f :: c -> (a, b)
f = Tree c -> (Tree a, Tree b)
go where
go :: Tree c -> (Tree a, Tree b)
go (T.Node x :: c
x xs :: Forest c
xs) = (a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
T.Node a
y Forest a
ys, b -> Forest b -> Tree b
forall a. a -> Forest a -> Tree a
T.Node b
z Forest b
zs) where
~(y :: a
y, z :: b
z) = c -> (a, b)
f c
x
~(ys :: Forest a
ys, zs :: Forest b
zs) = (Tree c -> (Tree a, Tree b)) -> Forest c -> (Forest a, Forest b)
forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith Tree c -> (Tree a, Tree b)
go Forest c
xs
instance Ord k => Semialign (Map k) where
#if MIN_VERSION_containers(0,5,9)
alignWith :: (These a b -> c) -> Map k a -> Map k b -> Map k c
alignWith f :: These a b -> c
f = SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge ((k -> a -> c) -> SimpleWhenMissing k a c
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\_ x :: a
x -> These a b -> c
f (a -> These a b
forall a b. a -> These a b
This a
x)))
((k -> b -> c) -> SimpleWhenMissing k b c
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\_ y :: b
y -> These a b -> c
f (b -> These a b
forall a b. b -> These a b
That b
y)))
((k -> a -> b -> c) -> SimpleWhenMatched k a b c
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\_ x :: a
x y :: b
y -> These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y)))
#elif MIN_VERSION_containers(0,5,0)
alignWith f = Map.mergeWithKey (\_ x y -> Just $ f $ These x y) (fmap (f . This)) (fmap (f . That))
#else
align m n = Map.unionWith merge (Map.map This m) (Map.map That n)
where merge (This a) (That b) = These a b
merge _ _ = oops "Align Map: merge"
#endif
instance (Ord k) => Align (Map k) where
nil :: Map k a
nil = Map k a
forall k a. Map k a
Map.empty
instance Ord k => Unalign (Map k) where
unalign :: Map k (These a b) -> (Map k a, Map k b)
unalign xs :: Map k (These a b)
xs = ((These a b -> Maybe a) -> Map k (These a b) -> Map k a
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justHere Map k (These a b)
xs, (These a b -> Maybe b) -> Map k (These a b) -> Map k b
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThere Map k (These a b)
xs)
instance Ord k => Unzip (Map k) where unzip :: Map k (a, b) -> (Map k a, Map k b)
unzip = Map k (a, b) -> (Map k a, Map k b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Ord k => Zip (Map k) where
zipWith :: (a -> b -> c) -> Map k a -> Map k b -> Map k c
zipWith = (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
instance Semialign IntMap where
#if MIN_VERSION_containers(0,5,9)
alignWith :: (These a b -> c) -> IntMap a -> IntMap b -> IntMap c
alignWith f :: These a b -> c
f = SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> IntMap c
forall a c b.
SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> IntMap c
IntMap.merge ((Int -> a -> c) -> SimpleWhenMissing a c
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
IntMap.mapMissing (\_ x :: a
x -> These a b -> c
f (a -> These a b
forall a b. a -> These a b
This a
x)))
((Int -> b -> c) -> SimpleWhenMissing b c
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
IntMap.mapMissing (\_ y :: b
y -> These a b -> c
f (b -> These a b
forall a b. b -> These a b
That b
y)))
((Int -> a -> b -> c) -> SimpleWhenMatched a b c
forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> z) -> WhenMatched f x y z
IntMap.zipWithMatched (\_ x :: a
x y :: b
y -> These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y)))
#elif MIN_VERSION_containers(0,5,0)
alignWith f = IntMap.mergeWithKey (\_ x y -> Just $ f $ These x y) (fmap (f . This)) (fmap (f . That))
#else
align m n = IntMap.unionWith merge (IntMap.map This m) (IntMap.map That n)
where merge (This a) (That b) = These a b
merge _ _ = oops "Align IntMap: merge"
#endif
instance Align IntMap where
nil :: IntMap a
nil = IntMap a
forall a. IntMap a
IntMap.empty
instance Unalign IntMap where
unalign :: IntMap (These a b) -> (IntMap a, IntMap b)
unalign xs :: IntMap (These a b)
xs = ((These a b -> Maybe a) -> IntMap (These a b) -> IntMap a
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justHere IntMap (These a b)
xs, (These a b -> Maybe b) -> IntMap (These a b) -> IntMap b
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThere IntMap (These a b)
xs)
instance Unzip IntMap where unzip :: IntMap (a, b) -> (IntMap a, IntMap b)
unzip = IntMap (a, b) -> (IntMap a, IntMap b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Zip IntMap where
zipWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
zipWith = (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith
instance Semialign Identity where
alignWith :: (These a b -> c) -> Identity a -> Identity b -> Identity c
alignWith f :: These a b -> c
f (Identity a :: a
a) (Identity b :: b
b) = c -> Identity c
forall a. a -> Identity a
Identity (These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b))
instance Zip Identity where
zipWith :: (a -> b -> c) -> Identity a -> Identity b -> Identity c
zipWith f :: a -> b -> c
f (Identity a :: a
a) (Identity b :: b
b) = c -> Identity c
forall a. a -> Identity a
Identity (a -> b -> c
f a
a b
b)
instance Repeat Identity where
repeat :: a -> Identity a
repeat = a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Unzip Identity where
unzip :: Identity (a, b) -> (Identity a, Identity b)
unzip (Identity ~(a :: a
a, b :: b
b)) = (a -> Identity a
forall a. a -> Identity a
Identity a
a, b -> Identity b
forall a. a -> Identity a
Identity b
b)
instance (Semialign f, Semialign g) => Semialign (Product f g) where
align :: Product f g a -> Product f g b -> Product f g (These a b)
align (Pair a :: f a
a b :: g a
b) (Pair c :: f b
c d :: g b
d) = f (These a b) -> g (These a b) -> Product f g (These a b)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f a -> f b -> f (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align f a
a f b
c) (g a -> g b -> g (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align g a
b g b
d)
alignWith :: (These a b -> c) -> Product f g a -> Product f g b -> Product f g c
alignWith f :: These a b -> c
f (Pair a :: f a
a b :: g a
b) (Pair c :: f b
c d :: g b
d) = f c -> g c -> Product f g c
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((These a b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f f a
a f b
c) ((These a b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f g a
b g b
d)
instance (Unalign f, Unalign g) => Unalign (Product f g) where
unalign :: Product f g (These a b) -> (Product f g a, Product f g b)
unalign (Pair a :: f (These a b)
a b :: g (These a b)
b) = (f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
al g a
bl, f b -> g b -> Product f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f b
ar g b
br) where
~(al :: f a
al, ar :: f b
ar) = f (These a b) -> (f a, f b)
forall (f :: * -> *) a b. Unalign f => f (These a b) -> (f a, f b)
unalign f (These a b)
a
~(bl :: g a
bl, br :: g b
br) = g (These a b) -> (g a, g b)
forall (f :: * -> *) a b. Unalign f => f (These a b) -> (f a, f b)
unalign g (These a b)
b
instance (Align f, Align g) => Align (Product f g) where
nil :: Product f g a
nil = f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
forall (f :: * -> *) a. Align f => f a
nil g a
forall (f :: * -> *) a. Align f => f a
nil
instance (Zip f, Zip g) => Zip (Product f g) where
zip :: Product f g a -> Product f g b -> Product f g (a, b)
zip (Pair a :: f a
a b :: g a
b) (Pair c :: f b
c d :: g b
d) = f (a, b) -> g (a, b) -> Product f g (a, b)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip f a
a f b
c) (g a -> g b -> g (a, b)
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip g a
b g b
d)
zipWith :: (a -> b -> c) -> Product f g a -> Product f g b -> Product f g c
zipWith f :: a -> b -> c
f (Pair a :: f a
a b :: g a
b) (Pair c :: f b
c d :: g b
d) = f c -> g c -> Product f g c
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f f a
a f b
c) ((a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f g a
b g b
d)
instance (Repeat f, Repeat g) => Repeat (Product f g) where
repeat :: a -> Product f g a
repeat x :: a
x = f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (a -> f a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x) (a -> g a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x)
instance (Unzip f, Unzip g) => Unzip (Product f g) where
unzip :: Product f g (a, b) -> (Product f g a, Product f g b)
unzip (Pair a :: f (a, b)
a b :: g (a, b)
b) = (f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
al g a
bl, f b -> g b -> Product f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f b
ar g b
br) where
~(al :: f a
al, ar :: f b
ar) = f (a, b) -> (f a, f b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip f (a, b)
a
~(bl :: g a
bl, br :: g b
br) = g (a, b) -> (g a, g b)
forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip g (a, b)
b
instance (Semialign f, Semialign g) => Semialign (Compose f g) where
alignWith :: (These a b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
alignWith f :: These a b -> c
f (Compose x :: f (g a)
x) (Compose y :: f (g b)
y) = f (g c) -> Compose f g c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((These (g a) (g b) -> g c) -> f (g a) -> f (g b) -> f (g c)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (g a) (g b) -> g c
forall (f :: * -> *). Semialign f => These (f a) (f b) -> f c
g f (g a)
x f (g b)
y) where
g :: These (f a) (f b) -> f c
g (This ga :: f a
ga) = (a -> c) -> f a -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f (These a b -> c) -> (a -> These a b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These a b
forall a b. a -> These a b
This) f a
ga
g (That gb :: f b
gb) = (b -> c) -> f b -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f (These a b -> c) -> (b -> These a b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> These a b
forall a b. b -> These a b
That) f b
gb
g (These ga :: f a
ga gb :: f b
gb) = (These a b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f f a
ga f b
gb
instance (Align f, Semialign g) => Align (Compose f g) where
nil :: Compose f g a
nil = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
forall (f :: * -> *) a. Align f => f a
nil
instance (Zip f, Zip g) => Zip (Compose f g) where
zipWith :: (a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
zipWith f :: a -> b -> c
f (Compose x :: f (g a)
x) (Compose y :: f (g b)
y) = f (g c) -> Compose f g c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((g a -> g b -> g c) -> f (g a) -> f (g b) -> f (g c)
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith ((a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f) f (g a)
x f (g b)
y)
instance (Repeat f, Repeat g) => Repeat (Compose f g) where
repeat :: a -> Compose f g a
repeat x :: a
x = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (g a -> f (g a)
forall (f :: * -> *) a. Repeat f => a -> f a
repeat (a -> g a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x))
instance (Unzip f, Unzip g) => Unzip (Compose f g) where
unzipWith :: (c -> (a, b)) -> Compose f g c -> (Compose f g a, Compose f g b)
unzipWith f :: c -> (a, b)
f (Compose x :: f (g c)
x) = (f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
y, f (g b) -> Compose f g b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g b)
z) where
~(y :: f (g a)
y, z :: f (g b)
z) = (g c -> (g a, g b)) -> f (g c) -> (f (g a), f (g b))
forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith ((c -> (a, b)) -> g c -> (g a, g b)
forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith c -> (a, b)
f) f (g c)
x
instance Monad m => Align (Stream m) where
nil :: Stream m a
nil = Stream m a
forall (m :: * -> *) a. Monad m => Stream m a
Stream.empty
instance Monad m => Semialign (Stream m) where
#if MIN_VERSION_vector(0,11,0)
alignWith :: (These a b -> c) -> Stream m a -> Stream m b -> Stream m c
alignWith f :: These a b -> c
f (Stream stepa :: s -> m (Step s a)
stepa ta :: s
ta) (Stream stepb :: s -> m (Step s b)
stepb tb :: s
tb)
= ((s, s, Maybe a, Bool) -> m (Step (s, s, Maybe a, Bool) c))
-> (s, s, Maybe a, Bool) -> Stream m c
forall (m :: * -> *) a s. (s -> m (Step s a)) -> s -> Stream m a
Stream (s, s, Maybe a, Bool) -> m (Step (s, s, Maybe a, Bool) c)
step (s
ta, s
tb, Maybe a
forall a. Maybe a
Nothing, Bool
False)
#else
alignWith f (Stream stepa ta na) (Stream stepb tb nb)
= Stream step (ta, tb, Nothing, False) (Stream.larger na nb)
#endif
where
step :: (s, s, Maybe a, Bool) -> m (Step (s, s, Maybe a, Bool) c)
step (sa :: s
sa, sb :: s
sb, Nothing, False) = do
Step s a
r <- s -> m (Step s a)
stepa s
sa
Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c))
-> Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
Yield x :: a
x sa' :: s
sa' -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall s a. s -> Step s a
Skip (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
x, Bool
False)
Skip sa' :: s
sa' -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall s a. s -> Step s a
Skip (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing, Bool
False)
Done -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall s a. s -> Step s a
Skip (s
sa, s
sb, Maybe a
forall a. Maybe a
Nothing, Bool
True)
step (sa :: s
sa, sb :: s
sb, av :: Maybe a
av, adone :: Bool
adone) = do
Step s b
r <- s -> m (Step s b)
stepb s
sb
Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c))
-> Step (s, s, Maybe a, Bool) c -> m (Step (s, s, Maybe a, Bool) c)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Yield y :: b
y sb' :: s
sb' -> c -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall a s. a -> s -> Step s a
Yield (These a b -> c
f (These a b -> c) -> These a b -> c
forall a b. (a -> b) -> a -> b
$ These a b -> (a -> These a b) -> Maybe a -> These a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> These a b
forall a b. b -> These a b
That b
y) (a -> b -> These a b
forall a b. a -> b -> These a b
`These` b
y) Maybe a
av)
(s
sa, s
sb', Maybe a
forall a. Maybe a
Nothing, Bool
adone)
Skip sb' :: s
sb' -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall s a. s -> Step s a
Skip (s
sa, s
sb', Maybe a
av, Bool
adone)
Done -> case (Maybe a
av, Bool
adone) of
(Just x :: a
x, False) -> c -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall a s. a -> s -> Step s a
Yield (These a b -> c
f (These a b -> c) -> These a b -> c
forall a b. (a -> b) -> a -> b
$ a -> These a b
forall a b. a -> These a b
This a
x) (s
sa, s
sb, Maybe a
forall a. Maybe a
Nothing, Bool
adone)
(_, True) -> Step (s, s, Maybe a, Bool) c
forall s a. Step s a
Done
_ -> (s, s, Maybe a, Bool) -> Step (s, s, Maybe a, Bool) c
forall s a. s -> Step s a
Skip (s
sa, s
sb, Maybe a
forall a. Maybe a
Nothing, Bool
False)
instance Monad m => Zip (Stream m) where
zipWith :: (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith = (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
Stream.zipWith
#if MIN_VERSION_vector(0,11,0)
instance Monad m => Align (Bundle m v) where
nil :: Bundle m v a
nil = Bundle m v a
forall (m :: * -> *) (v :: * -> *) a. Monad m => Bundle m v a
Bundle.empty
instance Monad m => Semialign (Bundle m v) where
alignWith :: (These a b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
alignWith f :: These a b -> c
f Bundle{sElems :: forall (m :: * -> *) (v :: * -> *) a. Bundle m v a -> Stream m a
sElems = Stream m a
sa, sSize :: forall (m :: * -> *) (v :: * -> *) a. Bundle m v a -> Size
sSize = Size
na} Bundle{sElems :: forall (m :: * -> *) (v :: * -> *) a. Bundle m v a -> Stream m a
sElems = Stream m b
sb, sSize :: forall (m :: * -> *) (v :: * -> *) a. Bundle m v a -> Size
sSize = Size
nb}
= Stream m c -> Size -> Bundle m v c
forall (m :: * -> *) a (v :: * -> *).
Monad m =>
Stream m a -> Size -> Bundle m v a
Bundle.fromStream ((These a b -> c) -> Stream m a -> Stream m b -> Stream m c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f Stream m a
sa Stream m b
sb) (Size -> Size -> Size
Bundle.larger Size
na Size
nb)
#endif
instance Monad m => Zip (Bundle m v) where
zipWith :: (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
zipWith = (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
forall (m :: * -> *) a b c (v :: * -> *).
Monad m =>
(a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
Bundle.zipWith
instance Semialign V.Vector where
alignWith :: (These a b -> c) -> Vector a -> Vector b -> Vector c
alignWith = (These a b -> c) -> Vector a -> Vector b -> Vector c
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(These a b -> c) -> v a -> v b -> v c
alignVectorWith
instance Zip V.Vector where
zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWith = (a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
instance Align V.Vector where
nil :: Vector a
nil = Vector a
forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty
instance Unzip V.Vector where
unzip :: Vector (a, b) -> (Vector a, Vector b)
unzip = Vector (a, b) -> (Vector a, Vector b)
forall a b. Vector (a, b) -> (Vector a, Vector b)
V.unzip
alignVectorWith :: (Vector v a, Vector v b, Vector v c)
=> (These a b -> c) -> v a -> v b -> v c
alignVectorWith :: (These a b -> c) -> v a -> v b -> v c
alignVectorWith f :: These a b -> c
f x :: v a
x y :: v b
y = Bundle v c -> v c
forall (v :: * -> *) a. Vector v a => Bundle v a -> v a
unstream (Bundle v c -> v c) -> Bundle v c -> v c
forall a b. (a -> b) -> a -> b
$ (These a b -> c) -> Bundle Id v a -> Bundle Id v b -> Bundle v c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f (v a -> Bundle Id v a
forall (v :: * -> *) a. Vector v a => v a -> Bundle v a
stream v a
x) (v b -> Bundle Id v b
forall (v :: * -> *) a. Vector v a => v a -> Bundle v a
stream v b
y)
instance (Eq k, Hashable k) => Align (HashMap k) where
nil :: HashMap k a
nil = HashMap k a
forall k v. HashMap k v
HM.empty
instance (Eq k, Hashable k) => Semialign (HashMap k) where
align :: HashMap k a -> HashMap k b -> HashMap k (These a b)
align m :: HashMap k a
m n :: HashMap k b
n = (These a b -> These a b -> These a b)
-> HashMap k (These a b)
-> HashMap k (These a b)
-> HashMap k (These a b)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith These a b -> These a b -> These a b
forall a b a b. These a b -> These a b -> These a b
merge ((a -> These a b) -> HashMap k a -> HashMap k (These a b)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> These a b
forall a b. a -> These a b
This HashMap k a
m) ((b -> These a b) -> HashMap k b -> HashMap k (These a b)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map b -> These a b
forall a b. b -> These a b
That HashMap k b
n)
where merge :: These a b -> These a b -> These a b
merge (This a :: a
a) (That b :: b
b) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b
merge _ _ = String -> These a b
forall a. String -> a
oops "Align HashMap: merge"
instance (Eq k, Hashable k) => Zip (HashMap k) where
zipWith :: (a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
zipWith = (a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith
instance (Eq k, Hashable k) => Unzip (HashMap k) where unzip :: HashMap k (a, b) -> (HashMap k a, HashMap k b)
unzip = HashMap k (a, b) -> (HashMap k a, HashMap k b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance (Eq k, Hashable k) => Unalign (HashMap k) where
unalign :: HashMap k (These a b) -> (HashMap k a, HashMap k b)
unalign xs :: HashMap k (These a b)
xs = ((These a b -> Maybe a) -> HashMap k (These a b) -> HashMap k a
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justHere HashMap k (These a b)
xs, (These a b -> Maybe b) -> HashMap k (These a b) -> HashMap k b
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThere HashMap k (These a b)
xs)
instance Semialign (Tagged b) where
alignWith :: (These a b -> c) -> Tagged b a -> Tagged b b -> Tagged b c
alignWith f :: These a b -> c
f (Tagged x :: a
x) (Tagged y :: b
y) = c -> Tagged b c
forall k (s :: k) b. b -> Tagged s b
Tagged (These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y))
instance Zip (Tagged b) where
zipWith :: (a -> b -> c) -> Tagged b a -> Tagged b b -> Tagged b c
zipWith f :: a -> b -> c
f (Tagged x :: a
x) (Tagged y :: b
y) = c -> Tagged b c
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> b -> c
f a
x b
y)
instance Repeat (Tagged b) where
repeat :: a -> Tagged b a
repeat = a -> Tagged b a
forall k (s :: k) b. b -> Tagged s b
Tagged
instance Unzip (Tagged b) where
unzip :: Tagged b (a, b) -> (Tagged b a, Tagged b b)
unzip (Tagged ~(a :: a
a, b :: b
b)) = (a -> Tagged b a
forall k (s :: k) b. b -> Tagged s b
Tagged a
a, b -> Tagged b b
forall k (s :: k) b. b -> Tagged s b
Tagged b
b)
instance Semialign Proxy where
alignWith :: (These a b -> c) -> Proxy a -> Proxy b -> Proxy c
alignWith _ _ _ = Proxy c
forall k (t :: k). Proxy t
Proxy
align :: Proxy a -> Proxy b -> Proxy (These a b)
align _ _ = Proxy (These a b)
forall k (t :: k). Proxy t
Proxy
instance Align Proxy where
nil :: Proxy a
nil = Proxy a
forall k (t :: k). Proxy t
Proxy
instance Unalign Proxy where
unalign :: Proxy (These a b) -> (Proxy a, Proxy b)
unalign _ = (Proxy a
forall k (t :: k). Proxy t
Proxy, Proxy b
forall k (t :: k). Proxy t
Proxy)
instance Zip Proxy where
zipWith :: (a -> b -> c) -> Proxy a -> Proxy b -> Proxy c
zipWith _ _ _ = Proxy c
forall k (t :: k). Proxy t
Proxy
zip :: Proxy a -> Proxy b -> Proxy (a, b)
zip _ _ = Proxy (a, b)
forall k (t :: k). Proxy t
Proxy
instance Repeat Proxy where
repeat :: a -> Proxy a
repeat _ = Proxy a
forall k (t :: k). Proxy t
Proxy
instance Unzip Proxy where
unzip :: Proxy (a, b) -> (Proxy a, Proxy b)
unzip _ = (Proxy a
forall k (t :: k). Proxy t
Proxy, Proxy b
forall k (t :: k). Proxy t
Proxy)
salign :: (Semialign f, Semigroup a) => f a -> f a -> f a
salign :: f a -> f a -> f a
salign = (These a a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith ((a -> a -> a) -> These a a -> a
forall a. (a -> a -> a) -> These a a -> a
mergeThese a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>))
padZip :: (Semialign f) => f a -> f b -> f (Maybe a, Maybe b)
padZip :: f a -> f b -> f (Maybe a, Maybe b)
padZip = (These a b -> (Maybe a, Maybe b))
-> f a -> f b -> f (Maybe a, Maybe b)
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith (Maybe a
-> Maybe b -> These (Maybe a) (Maybe b) -> (Maybe a, Maybe b)
forall a b. a -> b -> These a b -> (a, b)
fromThese Maybe a
forall a. Maybe a
Nothing Maybe b
forall a. Maybe a
Nothing (These (Maybe a) (Maybe b) -> (Maybe a, Maybe b))
-> (These a b -> These (Maybe a) (Maybe b))
-> These a b
-> (Maybe a, Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a)
-> (b -> Maybe b) -> These a b -> These (Maybe a) (Maybe b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Maybe a
forall a. a -> Maybe a
Just b -> Maybe b
forall a. a -> Maybe a
Just)
padZipWith :: (Semialign f) => (Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith :: (Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith f :: Maybe a -> Maybe b -> c
f xs :: f a
xs ys :: f b
ys = (Maybe a -> Maybe b -> c) -> (Maybe a, Maybe b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe a -> Maybe b -> c
f ((Maybe a, Maybe b) -> c) -> f (Maybe a, Maybe b) -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f b -> f (Maybe a, Maybe b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (Maybe a, Maybe b)
padZip f a
xs f b
ys
lpadZipWith :: (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith :: (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith f :: Maybe a -> b -> c
f xs :: [a]
xs ys :: [b]
ys = [Maybe c] -> [c]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe c] -> [c]) -> [Maybe c] -> [c]
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Maybe b -> Maybe c) -> [a] -> [b] -> [Maybe c]
forall (f :: * -> *) a b c.
Semialign f =>
(Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith (\x :: Maybe a
x y :: Maybe b
y -> Maybe a -> b -> c
f Maybe a
x (b -> c) -> Maybe b -> Maybe c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
y) [a]
xs [b]
ys
lpadZip :: [a] -> [b] -> [(Maybe a, b)]
lpadZip :: [a] -> [b] -> [(Maybe a, b)]
lpadZip = (Maybe a -> b -> (Maybe a, b)) -> [a] -> [b] -> [(Maybe a, b)]
forall a b c. (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith (,)
rpadZipWith :: (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith :: (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith f :: a -> Maybe b -> c
f xs :: [a]
xs ys :: [b]
ys = (Maybe b -> a -> c) -> [b] -> [a] -> [c]
forall a b c. (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith ((a -> Maybe b -> c) -> Maybe b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe b -> c
f) [b]
ys [a]
xs
rpadZip :: [a] -> [b] -> [(a, Maybe b)]
rpadZip :: [a] -> [b] -> [(a, Maybe b)]
rpadZip = (a -> Maybe b -> (a, Maybe b)) -> [a] -> [b] -> [(a, Maybe b)]
forall a b c. (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith (,)