{-# 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

-- containers <0.5
#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 :: 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
. (String
"Data.Align: internal error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)

-- --------------------------------------------------------------------------
-- | Functors supporting an 'align' operation that takes the union of
-- non-uniform shapes.
--
-- Minimal definition: either 'align' or 'alignWith'.
--
-- == Laws
--
-- The laws of 'align' and 'zip' resemble lattice laws.
-- There is a plenty of laws, but they are simply satisfied.
--
-- And an addition property if @f@ is 'Foldable',
-- which tries to enforce 'align'-feel:
-- neither values are duplicated nor lost.
--
--
-- /Note:/ @'join' f x = f x x@
--
-- /Idempotency/
--
-- @
-- join align ≡ fmap (join These)
-- @
--
-- /Commutativity/
--
-- @
-- align x y ≡ swap \<$> align y x
-- @
--
-- /Associativity/
--
-- @
-- align x (align y z) ≡ assoc \<$> align (align x y) z
-- @
--
-- /With/
--
-- @
-- alignWith f a b ≡ f \<$> align a b
-- @
--
-- /Functoriality/
--
-- @
-- align (f \<$> x) (g \<$> y) ≡ bimap f g \<$> align x y
-- @
--
-- /Alignedness/, if @f@ is 'Foldable'
--
-- @
-- toList x ≡ toListOf (folded . here) (align x y)
--          ≡ mapMaybe justHere (toList (align x y))
-- @
--
--
-- And an addition property if @f@ is 'Foldable',
-- which tries to enforce 'align'-feel:
-- neither values are duplicated nor lost.
--
-- @
-- toList x = toListOf (folded . here) (align x y)
--          = mapMaybe justHere (toList (align x y))
-- @
--
class Functor f => Semialign f where
    -- | Analogous to @'zip'@, combines two structures by taking the union of
    --   their shapes and using @'These'@ to hold the elements.
    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

    -- | Analogous to @'zipWith'@, combines two structures by taking the union of
    --   their shapes and combining the elements with the given function.
    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 (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

-- | A unit of 'align'.
--
-- == Laws
--
-- @
-- (\`align` nil) ≡ fmap This
-- (nil \`align`) ≡ fmap That
-- @
--
class Semialign f => Align f where
    -- | An empty structure. @'align'@ing with @'nil'@ will produce a structure with
    --   the same shape and elements as the other input, modulo @'This'@ or @'That'@.
    nil :: f a

-- |
--
-- Alignable functors supporting an \"inverse\" to 'align': splitting
-- a union shape into its component parts.
--
-- == Laws
--
-- @
-- uncurry align (unalign xs) ≡ xs
-- unalign (align xs ys) ≡ (xs, ys)
-- @
--
-- == Compatibility note
--
-- In version 1 'unalign' was changed to return @(f a, f b)@ pair,
-- instead of @(f (Just a), f (Just b))@. Old behaviour can be achieved with
-- if ever needed.
--
-- >>> unzipWith (unalign . Just) [This 'a', That 'b', These 'c' 'd']
-- ([Just 'a',Nothing,Just 'c'],[Nothing,Just 'b',Just 'd'])
--
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 c -> These a b
f 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


-- | Functors supporting a 'zip' operation that takes the intersection of
-- non-uniform shapes.
--
-- Minimal definition: either 'zip' or 'zipWith'.
--
-- /Idempotency/
--
-- @
-- join zip   ≡ fmap (join (,))
-- @
--
-- /Commutativity/
--
-- @
-- zip x y ≡ swap \<$> zip y x
-- @
--
-- /Associativity/
--
-- @
-- zip x (zip y z) ≡ assoc \<$> zip (zip x y) z
-- @
--
-- /Absorption/
--
-- @
-- fst    \<$> zip xs (align xs ys) ≡ xs
-- toThis \<$> align xs (zip xs ys) ≡ This \<$> xs
--   where
--     toThis (This a)    = This a
--     toThis (These a _) = This a
--     toThis (That b)    = That b
-- @
--
-- /With/
--
-- @
-- zipWith f a b ≡ f \<$> zip a b
-- @
--
-- /Functoriality/
--
-- @
-- zip (f \<$> x) (g \<$> y) ≡ bimap f g \<$> zip x y
-- @
--
-- /Zippyness/
--
-- @
-- fmap fst (zip x x) ≡ x
-- fmap snd (zip x x) ≡ x
-- zip (fmap fst x) (fmap snd x) ≡ x
-- @
--
-- /Distributivity/
--
-- @
--                    align (zip xs ys) zs ≡ undistrThesePair \<$> zip (align xs zs) (align ys zs)
-- distrPairThese \<$> zip (align xs ys) zs ≡                      align (zip xs zs) (zip ys zs)
--                    zip (align xs ys) zs ≡ undistrPairThese \<$> align (zip xs zs) (zip ys zs)
-- @
--
-- /Note/, the following doesn't hold:
--
-- @
-- distrThesePair \<$> align (zip xs ys) zs ≢ zip (align xs zs) (align ys zs)
-- @
--
-- when @xs = []@ and @ys = zs = [0]@, then
-- the left hand side is "only" @[('That' 0, 'That' 0)]@,
-- but the right hand side is @[('That' 0, 'These' 0 0)]@.
--
class Semialign f => Zip f where
    -- | Combines two structures by taking the intersection of their shapes
    -- and using pair to hold the elements.
    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 (,)
    --
    -- | Combines two structures by taking the intersection of their shapes
    -- and combining the elements with the given function.
    zipWith :: (a -> b -> c) -> f a -> f b -> f c
    zipWith a -> b -> c
f f a
a 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

-- | Zippable functors supporting left and right units
--
-- /Unit/
--
-- @
-- fst \<$> zip xs (repeat y) ≡ xs
-- snd \<$> zip (repeat x) ys ≡ ys
-- @
--
class Zip f => Repeat f where
    -- | A /repeat/ structure.
    repeat :: a -> f a

-- | Right inverse of 'zip'.
--
-- This class is definable for every 'Functor'. See 'unzipDefault'.
--
-- == Laws
--
-- @
-- uncurry zip (unzip xs) ≡ xs
-- unzip (zip xs xs) ≡ (xs, xs)
-- @
--
-- Note:
--
-- @
-- unzip (zip xs ys) ≢ (xs, _) or (_, ys)
-- @
--
-- For sequence-like types this holds, but for Map-like it doesn't.
--
class Zip f => Unzip f where
    unzipWith :: (c -> (a, b)) -> f c -> (f a, f b)
    unzipWith 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 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)

-- | Indexed version of 'Semialign'.
--
-- @since 1.2
class (FunctorWithIndex i f, Semialign f) => SemialignWithIndex i f | f -> i where
    -- | Analogous to 'alignWith', but also provides an index.
    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 = (i -> These a b -> c) -> f (These a b) -> f c
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> These a b -> c
f (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)

-- | Indexed version of 'Zip'.
--
-- @since 1.2
class (SemialignWithIndex i f, Zip f) => ZipWithIndex i f | f -> i where
    -- | Analogous to 'zipWith', but also provides an index.
    izipWith :: (i -> a -> b -> c) -> f a -> f b -> f c
    izipWith i -> a -> b -> c
f f a
a f b
b = (i -> (a, b) -> c) -> f (a, b) -> f c
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap ((a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> b -> c) -> (a, b) -> c)
-> (i -> a -> b -> c) -> i -> (a, b) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b -> c
f) (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)

-- | Indexed version of 'Repeat'.
--
-- @since 1.2
class (ZipWithIndex i f, Repeat f) => RepeatWithIndex i f | f -> i where
    -- | Analogous to 'repeat', but also provides an index.
    --
    -- This should be the same as 'tabulate' for representable functors.
    irepeat :: (i -> a) -> f a
    irepeat i -> a
f = (i -> (i -> a) -> a) -> f (i -> a) -> f a
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) ((i -> a) -> f (i -> a)
forall (f :: * -> *) a. Repeat f => a -> f a
repeat i -> a
f)

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------

instance Semialign ((->) e) where
    align :: (e -> a) -> (e -> b) -> e -> These a b
align e -> a
f e -> b
g 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 These a b -> c
h e -> a
f e -> b
g 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 e -> a
f e -> b
g 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 SemialignWithIndex e ((->) e) where
    ialignWith :: (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 (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 ZipWithIndex e ((->) e) where
    izipWith :: (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 :: (e -> a) -> e -> a
irepeat = (e -> a) -> e -> a
forall a. a -> a
id

instance Semialign Maybe where
    align :: Maybe a -> Maybe b -> Maybe (These a b)
align Maybe a
Nothing Maybe b
Nothing = Maybe (These a b)
forall a. Maybe a
Nothing
    align (Just a
a) Maybe b
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 Maybe a
Nothing (Just 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) (Just 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 Maybe a
Nothing  Maybe b
_        = Maybe (a, b)
forall a. Maybe a
Nothing
    zip (Just a
_) Maybe b
Nothing  = Maybe (a, b)
forall a. Maybe a
Nothing
    zip (Just a
a) (Just 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 Maybe (These a b)
Nothing            = (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
    unalign (Just (This 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))    = (Maybe a
forall a. Maybe a
Nothing, b -> Maybe b
forall a. a -> Maybe a
Just b
b)
    unalign (Just (These a
a 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 SemialignWithIndex () Maybe
instance ZipWithIndex () Maybe
instance RepeatWithIndex () Maybe

instance Semialign [] where
    align :: [a] -> [b] -> [These a b]
align [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 [] [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 (a
x:[a]
xs) (b
y:[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 SemialignWithIndex Int []
instance ZipWithIndex Int []
instance RepeatWithIndex Int []

-- | @'zipWith' = 'liftA2'@ .
instance Semialign ZipList where
    alignWith :: (These a b -> c) -> ZipList a -> ZipList b -> ZipList c
alignWith These a b -> c
f (ZipList [a]
xs) (ZipList [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   a -> b -> c
f (ZipList [a]
xs) (ZipList [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 [(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
        ([a]
ys, [b]
zs) = [(a, b)] -> ([a], [b])
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

-------------------------------------------------------------------------------
-- semigroups
-------------------------------------------------------------------------------

instance Semialign NonEmpty where
    align :: NonEmpty a -> NonEmpty b -> NonEmpty (These a b)
align (a
x :| [a]
xs) (b
y :| [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

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

-- deriving instance SemialignWithIndex () Option
-- deriving instance ZipWithIndex () Option
-- deriving instance RepeatWithIndex () Option
#endif

-------------------------------------------------------------------------------
-- containers: ListLike
-------------------------------------------------------------------------------

instance Semialign Seq where
    align :: Seq a -> Seq b -> Seq (These a b)
align Seq a
xs Seq b
ys = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
        Ordering
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
        Ordering
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
            (Seq b
ysl, 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
        Ordering
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
            (Seq a
xsl, 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 These a b -> c
f Seq a
xs Seq b
ys = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
xn Int
yn of
        Ordering
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
        Ordering
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
            (Seq b
ysl, 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
        Ordering
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
            (Seq a
xsl, 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 a
x 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 SemialignWithIndex Int Seq
instance ZipWithIndex Int Seq

instance Semialign T.Tree where
    align :: Tree a -> Tree b -> Tree (These a b)
align (T.Node a
x Forest a
xs) (T.Node b
y 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 a -> b -> c
f (T.Node a
x Forest a
xs) (T.Node b
y 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 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 c -> (a, b)
f = Tree c -> (Tree a, Tree b)
go where
        go :: Tree c -> (Tree a, Tree b)
go  (T.Node c
x 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
            ~(a
y, b
z) = c -> (a, b)
f c
x
            ~(Forest a
ys, 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

-------------------------------------------------------------------------------
-- containers: MapLike
-------------------------------------------------------------------------------

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 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 (\k
_ 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 (\k
_ 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 (\k
_ a
x 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 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 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 (\Int
_ 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 (\Int
_ 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 (\Int
_ a
x 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 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 SemialignWithIndex Int IntMap
instance ZipWithIndex Int IntMap where
    izipWith :: (Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
izipWith = (Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
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 :: (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
izipWith = (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey

-------------------------------------------------------------------------------
-- transformers
-------------------------------------------------------------------------------

instance Semialign Identity where
    alignWith :: (These a b -> c) -> Identity a -> Identity b -> Identity c
alignWith These a b -> c
f (Identity a
a) (Identity 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 a -> b -> c
f (Identity a
a) (Identity 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, 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 SemialignWithIndex () Identity
instance ZipWithIndex () Identity
instance RepeatWithIndex () Identity

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 f a
a g a
b) (Pair f b
c 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 These a b -> c
f (Pair f a
a g a
b) (Pair f b
c 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 f (These a b)
a 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
        ~(f a
al, 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
        ~(g a
bl, 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 f a
a g a
b) (Pair f b
c 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 a -> b -> c
f (Pair f a
a g a
b) (Pair f b
c 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 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 f (a, b)
a 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
        ~(f a
al, 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
        ~(g a
bl, 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 (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (Either i j) (Product f g) where
    ialignWith :: (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) = 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 f c
fc g c
gc where
        fc :: f c
fc = (i -> These a b -> c) -> f a -> f b -> f c
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 (Either i j -> These a b -> c)
-> (i -> Either i j) -> i -> These a b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa f b
fb
        gc :: g c
gc = (j -> These a b -> c) -> g a -> g b -> g c
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 (Either i j -> These a b -> c)
-> (j -> Either i j) -> j -> These a b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (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) = 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 f c
fc g c
gc where
        fc :: f c
fc = (i -> a -> b -> c) -> f a -> f b -> f c
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 (Either i j -> a -> b -> c)
-> (i -> Either i j) -> i -> a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left) f a
fa f b
fb
        gc :: g c
gc = (j -> a -> b -> c) -> g a -> g b -> g c
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 (Either i j -> a -> b -> c)
-> (j -> Either i j) -> j -> a -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
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 :: (Either i j -> a) -> Product f g a
irepeat Either i j -> a
f = 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 ((i -> a) -> f a
forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (Either i j -> a
f (Either i j -> a) -> (i -> Either i j) -> i -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either i j
forall a b. a -> Either a b
Left)) ((j -> a) -> g a
forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (Either i j -> a
f (Either i j -> a) -> (j -> Either i j) -> j -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Either i j
forall a b. b -> Either a b
Right))


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 These a b -> c
f (Compose f (g a)
x) (Compose 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 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 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 f a
ga 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 a -> b -> c
f (Compose f (g a)
x) (Compose 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 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 c -> (a, b)
f (Compose 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
        ~(f (g a)
y, 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

-- This is unlawful instance.
--
-- instance (Unalign f, Unalign g) => Unalign (Compose f g) where
--     unalignWith f (Compose x) = (Compose y, Compose z) where
--         ~(y, z) = unalignWith (uncurry These . unalignWith f) x

instance (SemialignWithIndex i f, SemialignWithIndex j g) => SemialignWithIndex (i, j) (Compose f g) where
    ialignWith :: ((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) = 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 (f (g c) -> Compose f g c) -> f (g c) -> Compose f g c
forall a b. (a -> b) -> a -> b
$ (i -> These (g a) (g b) -> g c) -> f (g a) -> f (g b) -> f (g c)
forall i (f :: * -> *) a b c.
SemialignWithIndex i f =>
(i -> These a b -> c) -> f a -> f b -> f c
ialignWith i -> These (g a) (g b) -> g c
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)     = (j -> a -> c) -> f a -> f c
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) (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 i
i (That f b
gb)     = (j -> b -> c) -> f b -> f c
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) (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 i
i (These f a
ga f b
gb) = (j -> These a b -> c) -> f a -> f b -> f c
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 :: ((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) = 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 f (g c)
fgc where
        fgc :: f (g c)
fgc = (i -> g a -> g b -> g c) -> f (g a) -> f (g b) -> f (g c)
forall i (f :: * -> *) a b c.
ZipWithIndex i f =>
(i -> a -> b -> c) -> f a -> f b -> f c
izipWith (\i
i -> (j -> a -> b -> c) -> g a -> g b -> g c
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 :: ((i, j) -> a) -> Compose f g a
irepeat (i, j) -> a
f = 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 ((i -> g a) -> f (g a)
forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (\i
i -> (j -> a) -> g a
forall i (f :: * -> *) a. RepeatWithIndex i f => (i -> a) -> f a
irepeat (\j
j -> (i, j) -> a
f (i
i, j
j))))

-------------------------------------------------------------------------------
-- vector
-------------------------------------------------------------------------------

-- Based on the Data.Vector.Fusion.Stream.Monadic zipWith implementation
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  These a b -> c
f (Stream s -> m (Step s a)
stepa s
ta) (Stream s -> m (Step s b)
stepb 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 (s
sa, s
sb, Maybe a
Nothing, Bool
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 a
x 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    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)
                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
True)

        step (s
sa, s
sb, Maybe a
av, 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 b
y 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 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)
                Step s b
Done -> case (Maybe a
av, Bool
adone) of
                    (Just a
x, Bool
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)
                    (Maybe a
_, Bool
True)       -> Step (s, s, Maybe a, Bool) c
forall s a. Step s a
Done
#if __GLASGOW_HASKELL__ < 902
                    (Maybe a, Bool)
_               -> (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)
#endif

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 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 These a b -> c
f v a
x 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 SemialignWithIndex Int V.Vector where
instance ZipWithIndex Int V.Vector where
    izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
izipWith = (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
V.izipWith

-------------------------------------------------------------------------------
-- unordered-containers
-------------------------------------------------------------------------------

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 HashMap k a
m 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) (That b
b) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b
            merge These a b
_ These a b
_ = String -> These a b
forall a. String -> a
oops String
"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 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 (Eq k, Hashable k) => SemialignWithIndex k (HashMap k) where
instance (Eq k, Hashable k) => ZipWithIndex k (HashMap k) where
    izipWith :: (k -> a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
izipWith = (k -> a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWithKey

-------------------------------------------------------------------------------
-- tagged
-------------------------------------------------------------------------------

instance Semialign (Tagged b) where
    alignWith :: (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) = 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 a -> b -> c
f (Tagged a
x) (Tagged 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, 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 SemialignWithIndex () (Tagged b)
instance ZipWithIndex () (Tagged b)
instance RepeatWithIndex () (Tagged b)

instance Semialign Proxy where
    alignWith :: (These a b -> c) -> Proxy a -> Proxy b -> Proxy c
alignWith These a b -> c
_ Proxy a
_ Proxy b
_ = Proxy c
forall k (t :: k). Proxy t
Proxy
    align :: Proxy a -> Proxy b -> Proxy (These a b)
align Proxy a
_ Proxy b
_       = 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 (These a b)
_ = (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 a -> b -> c
_ Proxy a
_ Proxy b
_ = Proxy c
forall k (t :: k). Proxy t
Proxy
    zip :: Proxy a -> Proxy b -> Proxy (a, b)
zip Proxy a
_ Proxy b
_       = Proxy (a, b)
forall k (t :: k). Proxy t
Proxy

instance Repeat Proxy where
    repeat :: a -> Proxy a
repeat a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

instance Unzip Proxy where
    unzip :: Proxy (a, b) -> (Proxy a, Proxy b)
unzip Proxy (a, b)
_ = (Proxy a
forall k (t :: k). Proxy t
Proxy, Proxy b
forall k (t :: k). Proxy t
Proxy)

instance SemialignWithIndex Void Proxy
instance ZipWithIndex Void Proxy
instance RepeatWithIndex Void Proxy

-------------------------------------------------------------------------------
-- combinators
-------------------------------------------------------------------------------

-- | Align two structures and combine with '<>'.
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
(<>))

-- | Align two structures as in 'zip', but filling in blanks with 'Nothing'.
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)

-- | Align two structures as in 'zipWith', but filling in blanks with 'Nothing'.
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 Maybe a -> Maybe b -> c
f f a
xs 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

-- | Left-padded 'zipWith'.
lpadZipWith :: (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith :: (Maybe a -> b -> c) -> [a] -> [b] -> [c]
lpadZipWith Maybe a -> b -> c
f [a]
xs [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 (\Maybe a
x 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

-- | Left-padded 'zip'.
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 (,)

-- | Right-padded 'zipWith'.
rpadZipWith :: (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith :: (a -> Maybe b -> c) -> [a] -> [b] -> [c]
rpadZipWith a -> Maybe b -> c
f [a]
xs [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

-- | Right-padded 'zip'.
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 (,)