{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
module Data.Semialign.Internal where
import Prelude
(Bool (..), Either (..), Eq (..), Functor (fmap), Int, Maybe (..),
Monad (..), Ord (..), Ordering (..), String, error, flip, fst, id,
maybe, snd, uncurry, ($), (++), (.))
import qualified Prelude as Prelude
import Control.Applicative (ZipList (..), pure, (<$>))
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.Monoid (Monoid (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (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 Data.Void (Void)
import Data.Functor.WithIndex (FunctorWithIndex (imap))
import Data.Functor.WithIndex.Instances ()
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
#if !(MIN_VERSION_base(4,16,0))
import Data.Semigroup (Option (..))
#endif
import Data.These
import Data.These.Combinators
oops :: String -> a
oops :: forall a. String -> a
oops = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Data.Align: internal error: " forall a. [a] -> [a] -> [a]
++)
class Functor f => Semialign f where
align :: f a -> f b -> f (These a b)
align = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith forall a. a -> a
id
alignWith :: (These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f f a
a f b
b = These a b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 = forall (f :: * -> *) c a b.
Unalign f =>
(c -> These a b) -> f c -> (f a, f b)
unalignWith forall a. a -> a
id
unalignWith :: (c -> These a b) -> f c -> (f a, f b)
unalignWith c -> These a b
f f c
fx = forall (f :: * -> *) a b. Unalign f => f (These a b) -> (f a, f b)
unalign (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 = 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 a -> b -> c
f f a
a f b
b = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 c -> (a, b)
f = forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith forall a. a -> a
id
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL unzipWith | unzip #-}
#endif
unzipDefault :: Functor f => f (a, b) -> (f a, f b)
unzipDefault :: forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault f (a, b)
x = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
x, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
x)
class (FunctorWithIndex i f, Semialign f) => SemialignWithIndex i f | f -> i where
ialignWith :: (i -> These a b -> c) -> f a -> f b -> f c
ialignWith i -> These a b -> c
f f a
a f b
b = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> These a b -> c
f (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align f a
a f b
b)
class (SemialignWithIndex i f, Zip f) => ZipWithIndex i f | f -> i where
izipWith :: (i -> a -> b -> c) -> f a -> f b -> f c
izipWith i -> a -> b -> c
f f a
a f b
b = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b -> c
f) (forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip f a
a f b
b)
class (ZipWithIndex i f, Repeat f) => RepeatWithIndex i f | f -> i where
irepeat :: (i -> a) -> f a
irepeat i -> a
f = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
i i -> a
f' -> i -> a
f' i
i) (forall (f :: * -> *) a. Repeat f => a -> f a
repeat i -> a
f)
instance Semialign ((->) e) where
align :: forall a b. (e -> a) -> (e -> b) -> e -> These a b
align e -> a
f e -> b
g e
x = forall a b. a -> b -> These a b
These (e -> a
f e
x) (e -> b
g e
x)
alignWith :: forall a b c. (These a b -> c) -> (e -> a) -> (e -> b) -> e -> c
alignWith These a b -> c
h e -> a
f e -> b
g e
x = These a b -> c
h (forall a b. a -> b -> These a b
These (e -> a
f e
x) (e -> b
g e
x))
instance Zip ((->) e) where
zip :: forall a b. (e -> a) -> (e -> b) -> e -> (a, b)
zip e -> a
f e -> b
g e
x = (e -> a
f e
x, e -> b
g e
x)
instance Repeat ((->) e) where
repeat :: forall a. a -> e -> a
repeat = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance SemialignWithIndex e ((->) e) where
ialignWith :: forall a b c.
(e -> These a b -> c) -> (e -> a) -> (e -> b) -> e -> c
ialignWith e -> These a b -> c
h e -> a
f e -> b
g e
x = e -> These a b -> c
h e
x (forall a b. a -> b -> These a b
These (e -> a
f e
x) (e -> b
g e
x))
instance ZipWithIndex e ((->) e) where
izipWith :: forall a b c. (e -> a -> b -> c) -> (e -> a) -> (e -> b) -> e -> c
izipWith e -> a -> b -> c
h e -> a
f e -> b
g e
x = e -> a -> b -> c
h e
x (e -> a
f e
x) (e -> b
g e
x)
instance RepeatWithIndex e ((->) e) where
irepeat :: forall a. (e -> a) -> e -> a
irepeat = forall a. a -> a
id
instance Semialign Maybe where
align :: forall a b. Maybe a -> Maybe b -> Maybe (These a b)
align Maybe a
Nothing Maybe b
Nothing = forall a. Maybe a
Nothing
align (Just a
a) Maybe b
Nothing = forall a. a -> Maybe a
Just (forall a b. a -> These a b
This a
a)
align Maybe a
Nothing (Just b
b) = forall a. a -> Maybe a
Just (forall a b. b -> These a b
That b
b)
align (Just a
a) (Just b
b) = forall a. a -> Maybe a
Just (forall a b. a -> b -> These a b
These a
a b
b)
instance Zip Maybe where
zip :: forall a b. Maybe a -> Maybe b -> Maybe (a, b)
zip Maybe a
Nothing Maybe b
_ = forall a. Maybe a
Nothing
zip (Just a
_) Maybe b
Nothing = forall a. Maybe a
Nothing
zip (Just a
a) (Just b
b) = forall a. a -> Maybe a
Just (a
a, b
b)
instance Repeat Maybe where
repeat :: forall a. a -> Maybe a
repeat = forall a. a -> Maybe a
Just
instance Unalign Maybe where
unalign :: forall a b. Maybe (These a b) -> (Maybe a, Maybe b)
unalign Maybe (These a b)
Nothing = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
unalign (Just (This a
a)) = (forall a. a -> Maybe a
Just a
a, forall a. Maybe a
Nothing)
unalign (Just (That b
b)) = (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just b
b)
unalign (Just (These a
a b
b)) = (forall a. a -> Maybe a
Just a
a, forall a. a -> Maybe a
Just b
b)
instance Unzip Maybe where
unzip :: forall a b. Maybe (a, b) -> (Maybe a, Maybe b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Align Maybe where
nil :: forall a. Maybe a
nil = forall a. Maybe a
Nothing
instance SemialignWithIndex () Maybe
instance ZipWithIndex () Maybe
instance RepeatWithIndex () Maybe
instance Semialign [] where
align :: forall a b. [a] -> [b] -> [These a b]
align [a]
xs [] = forall a b. a -> These a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
align [] [b]
ys = forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b]
ys
align (a
x:[a]
xs) (b
y:[b]
ys) = forall a b. a -> b -> These a b
These a
x b
y forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align [a]
xs [b]
ys
instance Align [] where
nil :: forall a. [a]
nil = []
instance Zip [] where
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip = forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith
instance Repeat [] where
repeat :: forall a. a -> [a]
repeat = forall a. a -> [a]
Prelude.repeat
instance Unzip [] where
unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip = forall a b. [(a, b)] -> ([a], [b])
Prelude.unzip
instance SemialignWithIndex Int []
instance ZipWithIndex Int []
instance RepeatWithIndex Int []
instance Semialign ZipList where
alignWith :: forall a b c.
(These a b -> c) -> ZipList a -> ZipList b -> ZipList c
alignWith These a b -> c
f (ZipList [a]
xs) (ZipList [b]
ys) = forall a. [a] -> ZipList a
ZipList (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 :: forall a. ZipList a
nil = forall a. [a] -> ZipList a
ZipList []
instance Zip ZipList where
zipWith :: forall a b c. (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
zipWith a -> b -> c
f (ZipList [a]
xs) (ZipList [b]
ys) = forall a. [a] -> ZipList a
ZipList (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 :: forall a. a -> ZipList a
repeat = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Unzip ZipList where
unzip :: forall a b. ZipList (a, b) -> (ZipList a, ZipList b)
unzip (ZipList [(a, b)]
xs) = (forall a. [a] -> ZipList a
ZipList [a]
ys, forall a. [a] -> ZipList a
ZipList [b]
zs) where
([a]
ys, [b]
zs) = forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip [(a, b)]
xs
instance SemialignWithIndex Int ZipList
instance ZipWithIndex Int ZipList
instance RepeatWithIndex Int ZipList
instance Semialign NonEmpty where
align :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (These a b)
align (a
x :| [a]
xs) (b
y :| [b]
ys) = forall a b. a -> b -> These a b
These a
x b
y forall a. a -> [a] -> NonEmpty a
:| forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align [a]
xs [b]
ys
instance Zip NonEmpty where
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip = forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip
zipWith :: forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith = forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith
instance Repeat NonEmpty where
repeat :: forall a. a -> NonEmpty a
repeat = forall a. a -> NonEmpty a
NE.repeat
instance Unzip NonEmpty where
unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip
instance SemialignWithIndex Int NonEmpty
instance ZipWithIndex Int NonEmpty
instance RepeatWithIndex Int NonEmpty
#if !(MIN_VERSION_base(4,16,0))
deriving instance Semialign Option
deriving instance Align Option
deriving instance Unalign Option
deriving instance Zip Option
deriving instance Repeat Option
deriving instance Unzip Option
#endif
instance Semialign Seq where
align :: forall a b. Seq a -> Seq b -> Seq (These a b)
align Seq a
xs Seq b
ys = case forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
Ordering
EQ -> forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith forall a b. a -> b -> These a b
fc Seq a
xs Seq b
ys
Ordering
LT -> case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
xn Seq b
ys of
(Seq b
ysl, Seq b
ysr) -> forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith forall a b. a -> b -> These a b
These Seq a
xs Seq b
ysl forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> These a b
That Seq b
ysr
Ordering
GT -> case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
yn Seq a
xs of
(Seq a
xsl, Seq a
xsr) -> forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith forall a b. a -> b -> These a b
These Seq a
xsl Seq b
ys forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> These a b
This Seq a
xsr
where
xn :: Int
xn = forall a. Seq a -> Int
Seq.length Seq a
xs
yn :: Int
yn = forall a. Seq a -> Int
Seq.length Seq b
ys
fc :: a -> b -> These a b
fc = forall a b. a -> b -> These a b
These
alignWith :: forall a b c. (These a b -> c) -> Seq a -> Seq b -> Seq c
alignWith These a b -> c
f Seq a
xs Seq b
ys = case forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
Ordering
EQ -> 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
Ordering
LT -> case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
xn Seq b
ys of
(Seq b
ysl, Seq b
ysr) -> 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 forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) Seq b
ysr
Ordering
GT -> case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
yn Seq a
xs of
(Seq a
xsl, Seq a
xsr) -> 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 forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) Seq a
xsr
where
xn :: Int
xn = forall a. Seq a -> Int
Seq.length Seq a
xs
yn :: Int
yn = forall a. Seq a -> Int
Seq.length Seq b
ys
fc :: a -> b -> c
fc a
x b
y = These a b -> c
f (forall a b. a -> b -> These a b
These a
x b
y)
instance Align Seq where
nil :: forall a. Seq a
nil = forall a. Seq a
Seq.empty
instance Unzip Seq where
#if MIN_VERSION_containers(0,5,11)
unzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip = forall a b. Seq (a, b) -> (Seq a, Seq b)
Seq.unzip
unzipWith :: forall c a b. (c -> (a, b)) -> Seq c -> (Seq a, Seq b)
unzipWith = forall c a b. (c -> (a, b)) -> Seq c -> (Seq a, Seq b)
Seq.unzipWith
#else
unzip = unzipDefault
#endif
instance Zip Seq where
zip :: forall a b. Seq a -> Seq b -> Seq (a, b)
zip = forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip
zipWith :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith
instance SemialignWithIndex Int Seq
instance ZipWithIndex Int Seq
instance Semialign T.Tree where
align :: forall a b. Tree a -> Tree b -> Tree (These a b)
align (T.Node a
x [Tree a]
xs) (T.Node b
y [Tree b]
ys) = forall a. a -> [Tree a] -> Tree a
T.Node (forall a b. a -> b -> These a b
These a
x b
y) (forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith (forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> These a b
This) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> These a b
That) forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align) [Tree a]
xs [Tree b]
ys)
instance Zip T.Tree where
zipWith :: forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWith a -> b -> c
f (T.Node a
x [Tree a]
xs) (T.Node b
y [Tree b]
ys) = forall a. a -> [Tree a] -> Tree a
T.Node (a -> b -> c
f a
x b
y) (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f) [Tree a]
xs [Tree b]
ys)
instance Repeat T.Tree where
repeat :: forall a. a -> Tree a
repeat a
x = Tree a
n where n :: Tree a
n = forall a. a -> [Tree a] -> Tree a
T.Node a
x (forall (f :: * -> *) a. Repeat f => a -> f a
repeat Tree a
n)
instance Unzip T.Tree where
unzipWith :: forall c a b. (c -> (a, b)) -> Tree c -> (Tree a, Tree b)
unzipWith c -> (a, b)
f = Tree c -> (Tree a, Tree b)
go where
go :: Tree c -> (Tree a, Tree b)
go (T.Node c
x [Tree c]
xs) = (forall a. a -> [Tree a] -> Tree a
T.Node a
y [Tree a]
ys, forall a. a -> [Tree a] -> Tree a
T.Node b
z [Tree b]
zs) where
~(a
y, b
z) = c -> (a, b)
f c
x
~([Tree a]
ys, [Tree b]
zs) = forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith Tree c -> (Tree a, Tree b)
go [Tree c]
xs
instance Ord k => Semialign (Map k) where
#if MIN_VERSION_containers(0,5,9)
alignWith :: forall a b c. (These a b -> c) -> Map k a -> Map k b -> Map k c
alignWith These a b -> c
f = 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 (forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\k
_ a
x -> These a b -> c
f (forall a b. a -> These a b
This a
x)))
(forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\k
_ b
y -> These a b -> c
f (forall a b. b -> These a b
That b
y)))
(forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\k
_ a
x b
y -> These a b -> c
f (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 :: forall a. Map k a
nil = forall k a. Map k a
Map.empty
instance Ord k => Unalign (Map k) where
unalign :: forall a b. Map k (These a b) -> (Map k a, Map k b)
unalign Map k (These a b)
xs = (forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a b. These a b -> Maybe a
justHere Map k (These a b)
xs, forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a b. These a b -> Maybe b
justThere Map k (These a b)
xs)
instance Ord k => Unzip (Map k) where unzip :: forall a b. Map k (a, b) -> (Map k a, Map k b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Ord k => Zip (Map k) where
zipWith :: forall a b c. (a -> b -> c) -> Map k a -> Map k b -> Map k c
zipWith = 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 :: forall a b c. (These a b -> c) -> IntMap a -> IntMap b -> IntMap c
alignWith These a b -> c
f = forall a c b.
SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> IntMap c
IntMap.merge (forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
IntMap.mapMissing (\Int
_ a
x -> These a b -> c
f (forall a b. a -> These a b
This a
x)))
(forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
IntMap.mapMissing (\Int
_ b
y -> These a b -> c
f (forall a b. b -> These a b
That b
y)))
(forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> z) -> WhenMatched f x y z
IntMap.zipWithMatched (\Int
_ a
x b
y -> These a b -> c
f (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 :: forall a. IntMap a
nil = forall a. IntMap a
IntMap.empty
instance Unalign IntMap where
unalign :: forall a b. IntMap (These a b) -> (IntMap a, IntMap b)
unalign IntMap (These a b)
xs = (forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe forall a b. These a b -> Maybe a
justHere IntMap (These a b)
xs, forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe forall a b. These a b -> Maybe b
justThere IntMap (These a b)
xs)
instance Unzip IntMap where unzip :: forall a b. IntMap (a, b) -> (IntMap a, IntMap b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance Zip IntMap where
zipWith :: forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
zipWith = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith
instance SemialignWithIndex Int IntMap
instance ZipWithIndex Int IntMap where
izipWith :: forall a b c.
(Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
izipWith = forall a b c.
(Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWithKey
instance Ord k => SemialignWithIndex k (Map k) where
instance Ord k => ZipWithIndex k (Map k) where
izipWith :: forall a b c. (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
izipWith = forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey
instance Semialign Identity where
alignWith :: forall a b c.
(These a b -> c) -> Identity a -> Identity b -> Identity c
alignWith These a b -> c
f (Identity a
a) (Identity b
b) = forall a. a -> Identity a
Identity (These a b -> c
f (forall a b. a -> b -> These a b
These a
a b
b))
instance Zip Identity where
zipWith :: forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
zipWith a -> b -> c
f (Identity a
a) (Identity b
b) = forall a. a -> Identity a
Identity (a -> b -> c
f a
a b
b)
instance Repeat Identity where
repeat :: forall a. a -> Identity a
repeat = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Unzip Identity where
unzip :: forall a b. Identity (a, b) -> (Identity a, Identity b)
unzip (Identity ~(a
a, b
b)) = (forall a. a -> Identity a
Identity a
a, forall a. a -> Identity a
Identity b
b)
instance SemialignWithIndex () Identity
instance ZipWithIndex () Identity
instance RepeatWithIndex () Identity
instance (Semialign f, Semialign g) => Semialign (Product f g) where
align :: forall a b.
Product f g a -> Product f g b -> Product f g (These a b)
align (Pair f a
a g a
b) (Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align f a
a f b
c) (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align g a
b g b
d)
alignWith :: forall a b c.
(These a b -> c) -> Product f g a -> Product f g b -> Product f g c
alignWith These a b -> c
f (Pair f a
a g a
b) (Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (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) (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 :: forall a b.
Product f g (These a b) -> (Product f g a, Product f g b)
unalign (Pair f (These a b)
a g (These a b)
b) = (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
al g a
bl, forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f b
ar g b
br) where
~(f a
al, f b
ar) = forall (f :: * -> *) a b. Unalign f => f (These a b) -> (f a, f b)
unalign f (These a b)
a
~(g a
bl, g b
br) = 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 :: forall a. Product f g a
nil = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a. Align f => f a
nil forall (f :: * -> *) a. Align f => f a
nil
instance (Zip f, Zip g) => Zip (Product f g) where
zip :: forall a b. Product f g a -> Product f g b -> Product f g (a, b)
zip (Pair f a
a g a
b) (Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip f a
a f b
c) (forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip g a
b g b
d)
zipWith :: forall a b c.
(a -> b -> c) -> Product f g a -> Product f g b -> Product f g c
zipWith a -> b -> c
f (Pair f a
a g a
b) (Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (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) (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 :: forall a. a -> Product f g a
repeat a
x = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x) (forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x)
instance (Unzip f, Unzip g) => Unzip (Product f g) where
unzip :: forall a b. Product f g (a, b) -> (Product f g a, Product f g b)
unzip (Pair f (a, b)
a g (a, b)
b) = (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
al g a
bl, forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f b
ar g b
br) where
~(f a
al, f b
ar) = forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip f (a, b)
a
~(g a
bl, g b
br) = forall (f :: * -> *) a b. Unzip f => f (a, b) -> (f a, f b)
unzip g (a, b)
b
instance (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (Either i j) (Product f g) where
ialignWith :: forall a b c.
(Either i j -> These a b -> c)
-> Product f g a -> Product f g b -> Product f g c
ialignWith Either i j -> These a b -> c
f (Pair f a
fa g a
ga) (Pair f b
fb g b
gb) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f c
fc g c
gc where
fc :: f c
fc = forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith (Either i j -> These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa f b
fb
gc :: g c
gc = forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith (Either i j -> These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga g b
gb
instance (ZipWithIndex i f, ZipWithIndex j g) => ZipWithIndex (Either i j) (Product f g) where
izipWith :: forall a b c.
(Either i j -> a -> b -> c)
-> Product f g a -> Product f g b -> Product f g c
izipWith Either i j -> a -> b -> c
f (Pair f a
fa g a
ga) (Pair f b
fb g b
gb) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f c
fc g c
gc where
fc :: f c
fc = forall i (f :: * -> *) a b c.
ZipWithIndex i f =>
(i -> a -> b -> c) -> f a -> f b -> f c
izipWith (Either i j -> a -> b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) f a
fa f b
fb
gc :: g c
gc = forall i (f :: * -> *) a b c.
ZipWithIndex i f =>
(i -> a -> b -> c) -> f a -> f b -> f c
izipWith (Either i j -> a -> b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) g a
ga g b
gb
instance (RepeatWithIndex i f, RepeatWithIndex j g) => RepeatWithIndex (Either i j) (Product f g) where
irepeat :: forall a. (Either i j -> a) -> Product f g a
irepeat Either i j -> a
f = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (Either i j -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)) (forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (Either i j -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right))
instance (Semialign f, Semialign g) => Semialign (Compose f g) where
alignWith :: forall a b c.
(These a b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
alignWith These a b -> c
f (Compose f (g a)
x) (Compose f (g b)
y) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith 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 f a
ga) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) f a
ga
g (That f b
gb) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (These a b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) f b
gb
g (These f a
ga f b
gb) = 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 :: forall a. Compose f g a
nil = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a. Align f => f a
nil
instance (Zip f, Zip g) => Zip (Compose f g) where
zipWith :: forall a b c.
(a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
zipWith a -> b -> c
f (Compose f (g a)
x) (Compose f (g b)
y) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (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 :: forall a. a -> Compose f g a
repeat a
x = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a. Repeat f => a -> f a
repeat (forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
x))
instance (Unzip f, Unzip g) => Unzip (Compose f g) where
unzipWith :: forall c a b.
(c -> (a, b)) -> Compose f g c -> (Compose f g a, Compose f g b)
unzipWith c -> (a, b)
f (Compose f (g c)
x) = (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
y, forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g b)
z) where
~(f (g a)
y, f (g b)
z) = forall (f :: * -> *) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith (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 (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (i, j) (Compose f g) where
ialignWith :: forall a b c.
((i, j) -> These a b -> c)
-> Compose f g a -> Compose f g b -> Compose f g c
ialignWith (i, j) -> These a b -> c
f (Compose f (g a)
fga) (Compose f (g b)
fgb) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith forall {f :: * -> *}.
SemialignWithIndex j f =>
i -> These (f a) (f b) -> f c
g f (g a)
fga f (g b)
fgb where
g :: i -> These (f a) (f b) -> f c
g i
i (This f a
ga) = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\j
j -> (i, j) -> These a b -> c
f (i
i, j
j) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> These a b
This) f a
ga
g i
i (That f b
gb) = forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\j
j -> (i, j) -> These a b -> c
f (i
i, j
j) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> These a b
That) f b
gb
g i
i (These f a
ga f b
gb) = forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith (\j
j -> (i, j) -> These a b -> c
f (i
i, j
j)) f a
ga f b
gb
instance (ZipWithIndex i f, ZipWithIndex j g) => ZipWithIndex (i, j) (Compose f g) where
izipWith :: forall a b c.
((i, j) -> a -> b -> c)
-> Compose f g a -> Compose f g b -> Compose f g c
izipWith (i, j) -> a -> b -> c
f (Compose f (g a)
fga) (Compose f (g b)
fgb) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g c)
fgc where
fgc :: f (g c)
fgc = forall i (f :: * -> *) a b c.
ZipWithIndex i f =>
(i -> a -> b -> c) -> f a -> f b -> f c
izipWith (\i
i -> forall i (f :: * -> *) a b c.
ZipWithIndex i f =>
(i -> a -> b -> c) -> f a -> f b -> f c
izipWith (\j
j -> (i, j) -> a -> b -> c
f (i
i, j
j))) f (g a)
fga f (g b)
fgb
instance (RepeatWithIndex i f, RepeatWithIndex j g) => RepeatWithIndex (i, j) (Compose f g) where
irepeat :: forall a. ((i, j) -> a) -> Compose f g a
irepeat (i, j) -> a
f = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (\i
i -> forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (\j
j -> (i, j) -> a
f (i
i, j
j))))
instance Monad m => Align (Stream m) where
nil :: forall a. Stream m a
nil = 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 :: forall a b c.
(These a b -> c) -> Stream m a -> Stream m b -> Stream m c
alignWith These a b -> c
f (Stream s -> m (Step s a)
stepa s
ta) (Stream s -> m (Step s b)
stepb s
tb)
= 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, 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 (s
sa, s
sb, Maybe a
Nothing, Bool
False) = do
Step s a
r <- s -> m (Step s a)
stepa s
sa
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s a
r of
Yield a
x s
sa' -> forall s a. s -> Step s a
Skip (s
sa', s
sb, forall a. a -> Maybe a
Just a
x, Bool
False)
Skip s
sa' -> forall s a. s -> Step s a
Skip (s
sa', s
sb, forall a. Maybe a
Nothing, Bool
False)
Step s a
Done -> forall s a. s -> Step s a
Skip (s
sa, s
sb, forall a. Maybe a
Nothing, Bool
True)
step (s
sa, s
sb, Maybe a
av, Bool
adone) = do
Step s b
r <- s -> m (Step s b)
stepb s
sb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s b
r of
Yield b
y s
sb' -> forall a s. a -> s -> Step s a
Yield (These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> These a b
That b
y) (forall a b. a -> b -> These a b
`These` b
y) Maybe a
av)
(s
sa, s
sb', forall a. Maybe a
Nothing, Bool
adone)
Skip s
sb' -> forall s a. s -> Step s a
Skip (s
sa, s
sb', Maybe a
av, Bool
adone)
Step s b
Done -> case (Maybe a
av, Bool
adone) of
(Just a
x, Bool
False) -> forall a s. a -> s -> Step s a
Yield (These a b -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> These a b
This a
x) (s
sa, s
sb, forall a. Maybe a
Nothing, Bool
adone)
(Maybe a
_, Bool
True) -> forall s a. Step s a
Done
#if __GLASGOW_HASKELL__ < 902
_ -> Skip (sa, sb, Nothing, False)
#endif
instance Monad m => Zip (Stream m) where
zipWith :: forall a b c.
(a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith = 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 :: forall a. Bundle m v a
nil = forall (m :: * -> *) (v :: * -> *) a. Monad m => Bundle m v a
Bundle.empty
instance Monad m => Semialign (Bundle m v) where
alignWith :: forall a b c.
(These a b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
alignWith 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}
= forall (m :: * -> *) a (v :: * -> *).
Monad m =>
Stream m a -> Size -> Bundle m v a
Bundle.fromStream (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 :: forall a b c.
(a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c
zipWith = 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 :: forall a b c. (These a b -> c) -> Vector a -> Vector b -> Vector c
alignWith = 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 :: forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWith = forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
instance Align V.Vector where
nil :: forall a. Vector a
nil = forall (v :: * -> *) a. Vector v a => v a
Data.Vector.Generic.empty
instance Unzip V.Vector where
unzip :: forall a b. Vector (a, b) -> (Vector a, Vector b)
unzip = 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 :: 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 These a b -> c
f v a
x v b
y = forall (v :: * -> *) a. Vector v a => Bundle v a -> v a
unstream forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f (forall (v :: * -> *) a. Vector v a => v a -> Bundle v a
stream v a
x) (forall (v :: * -> *) a. Vector v a => v a -> Bundle v a
stream v b
y)
instance SemialignWithIndex Int V.Vector where
instance ZipWithIndex Int V.Vector where
izipWith :: forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
izipWith = forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
V.izipWith
instance (Eq k, Hashable k) => Align (HashMap k) where
nil :: forall a. HashMap k a
nil = forall k v. HashMap k v
HM.empty
instance (Eq k, Hashable k) => Semialign (HashMap k) where
align :: forall a b. HashMap k a -> HashMap k b -> HashMap k (These a b)
align HashMap k a
m HashMap k b
n = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith forall {a} {b} {a} {b}. These a b -> These a b -> These a b
merge (forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map forall a b. a -> These a b
This HashMap k a
m) (forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map 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) (That b
b) = forall a b. a -> b -> These a b
These a
a b
b
merge These a b
_ These a b
_ = forall a. String -> a
oops String
"Align HashMap: merge"
instance (Eq k, Hashable k) => Zip (HashMap k) where
zipWith :: forall a b c.
(a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
zipWith = 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 :: forall a b. HashMap k (a, b) -> (HashMap k a, HashMap k b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzipDefault
instance (Eq k, Hashable k) => Unalign (HashMap k) where
unalign :: forall a b. HashMap k (These a b) -> (HashMap k a, HashMap k b)
unalign HashMap k (These a b)
xs = (forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe forall a b. These a b -> Maybe a
justHere HashMap k (These a b)
xs, forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe forall a b. These a b -> Maybe b
justThere HashMap k (These a b)
xs)
instance (Eq k, Hashable k) => SemialignWithIndex k (HashMap k) where
instance (Eq k, Hashable k) => ZipWithIndex k (HashMap k) where
izipWith :: forall a b c.
(k -> a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
izipWith = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWithKey
instance Semialign (Tagged b) where
alignWith :: forall a b c.
(These a b -> c) -> Tagged b a -> Tagged b b -> Tagged b c
alignWith These a b -> c
f (Tagged a
x) (Tagged b
y) = forall {k} (s :: k) b. b -> Tagged s b
Tagged (These a b -> c
f (forall a b. a -> b -> These a b
These a
x b
y))
instance Zip (Tagged b) where
zipWith :: forall a b c.
(a -> b -> c) -> Tagged b a -> Tagged b b -> Tagged b c
zipWith a -> b -> c
f (Tagged a
x) (Tagged b
y) = forall {k} (s :: k) b. b -> Tagged s b
Tagged (a -> b -> c
f a
x b
y)
instance Repeat (Tagged b) where
repeat :: forall a. a -> Tagged b a
repeat = forall {k} (s :: k) b. b -> Tagged s b
Tagged
instance Unzip (Tagged b) where
unzip :: forall a b. Tagged b (a, b) -> (Tagged b a, Tagged b b)
unzip (Tagged ~(a
a, b
b)) = (forall {k} (s :: k) b. b -> Tagged s b
Tagged a
a, forall {k} (s :: k) b. b -> Tagged s b
Tagged b
b)
instance SemialignWithIndex () (Tagged b)
instance ZipWithIndex () (Tagged b)
instance RepeatWithIndex () (Tagged b)
instance Semialign Proxy where
alignWith :: forall a b c. (These a b -> c) -> Proxy a -> Proxy b -> Proxy c
alignWith These a b -> c
_ Proxy a
_ Proxy b
_ = forall {k} (t :: k). Proxy t
Proxy
align :: forall a b. Proxy a -> Proxy b -> Proxy (These a b)
align Proxy a
_ Proxy b
_ = forall {k} (t :: k). Proxy t
Proxy
instance Align Proxy where
nil :: forall a. Proxy a
nil = forall {k} (t :: k). Proxy t
Proxy
instance Unalign Proxy where
unalign :: forall a b. Proxy (These a b) -> (Proxy a, Proxy b)
unalign Proxy (These a b)
_ = (forall {k} (t :: k). Proxy t
Proxy, forall {k} (t :: k). Proxy t
Proxy)
instance Zip Proxy where
zipWith :: forall a b c. (a -> b -> c) -> Proxy a -> Proxy b -> Proxy c
zipWith a -> b -> c
_ Proxy a
_ Proxy b
_ = forall {k} (t :: k). Proxy t
Proxy
zip :: forall a b. Proxy a -> Proxy b -> Proxy (a, b)
zip Proxy a
_ Proxy b
_ = forall {k} (t :: k). Proxy t
Proxy
instance Repeat Proxy where
repeat :: forall a. a -> Proxy a
repeat a
_ = forall {k} (t :: k). Proxy t
Proxy
instance Unzip Proxy where
unzip :: forall a b. Proxy (a, b) -> (Proxy a, Proxy b)
unzip Proxy (a, b)
_ = (forall {k} (t :: k). Proxy t
Proxy, forall {k} (t :: k). Proxy t
Proxy)
instance SemialignWithIndex Void Proxy
instance ZipWithIndex Void Proxy
instance RepeatWithIndex Void Proxy
salign :: (Semialign f, Semigroup a) => f a -> f a -> f a
salign :: forall (f :: * -> *) a.
(Semialign f, Semigroup a) =>
f a -> f a -> f a
salign = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith (forall a. (a -> a -> a) -> These a a -> a
mergeThese forall a. Semigroup a => a -> a -> a
(<>))
padZip :: (Semialign f) => f a -> f b -> f (Maybe a, Maybe b)
padZip :: forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (Maybe a, Maybe b)
padZip = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith (forall a b. a -> b -> These a b -> (a, b)
fromThese forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just)
padZipWith :: (Semialign f) => (Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith :: forall (f :: * -> *) a b c.
Semialign f =>
(Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith Maybe a -> Maybe b -> c
f f a
xs f b
ys = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe a -> Maybe b -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: forall a b c. (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith Maybe a -> b -> c
f [a]
xs [b]
ys = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Semialign f =>
(Maybe a -> Maybe b -> c) -> f a -> f b -> f c
padZipWith (\Maybe a
x Maybe b
y -> Maybe a -> b -> c
f Maybe a
x 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 :: forall a b. [a] -> [b] -> [(Maybe a, b)]
lpadZip = forall a b c. (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith (,)
rpadZipWith :: (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith :: forall a b c. (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith a -> Maybe b -> c
f [a]
xs [b]
ys = forall a b c. (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith (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 :: forall a b. [a] -> [b] -> [(a, Maybe b)]
rpadZip = forall a b c. (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith (,)