{-# LANGUAGE Trustworthy #-}

module GHC.Internal.Data.List.NonEmpty
  ( NonEmpty(..)
  , zip
  , zipWith
  ) where

import GHC.Internal.Base
import qualified GHC.Internal.Data.List as List

-- | The 'zip' function takes two streams and returns a stream of
-- corresponding pairs.
zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)
zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip ~(a
x :| [a]
xs) ~(b
y :| [b]
ys) = (a
x, b
y) (a, b) -> [(a, b)] -> NonEmpty (a, b)
forall a. a -> [a] -> NonEmpty a
:| [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip [a]
xs [b]
ys

-- | The 'zipWith' function generalizes 'zip'. Rather than tupling
-- the elements, the elements are combined using the function
-- passed as the first argument.
zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith :: forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith a -> b -> c
f ~(a
x :| [a]
xs) ~(b
y :| [b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> NonEmpty c
forall a. a -> [a] -> NonEmpty a
:| (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith a -> b -> c
f [a]
xs [b]
ys