{-|

Module      : ZipFold
Description : Zipping with folds
Copyright   : © Frank Jung, 2020
License     : GPL-3

From
<https://doisinkidney.com/posts/2020-08-22-some-more-list-algorithms.html Zipping with Folds>
which is based on
<http://okmij.org/ftp/Streams.html#zip-folds How to Zip with Folds>.

The 'Prelude's version of 'zip' uses recursion:

@
zip :: [a] -> [b] -> [(a,b)]
zip []     _bs    = []
zip _as    []     = []
zip (a:as) (b:bs) = (a,b) : zip as bs
@

But, this won't work for streams. The version included below /does/ work with
streams. It uses a recursive type to represent the stream data. This
matches from the beginning of the stream. You could match from the end of
the stream by swapping 'foldr' with 'foldl'.

-}

module ZipFold (Zip(..), zip, zip') where

import           Prelude hiding (zip)

-- | Defines a recursive type.
newtype Zip a b = Zip { forall a b. Zip a b -> a -> (Zip a b -> b) -> b
runZip :: a -> (Zip a b -> b) -> b }

-- | Function to fuse two folds.
zip :: [a] -> [b] -> [(a,b)]
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [b]
ys = (a -> (Zip a [(a, b)] -> [(a, b)]) -> Zip a [(a, b)] -> [(a, b)])
-> (Zip a [(a, b)] -> [(a, b)])
-> [a]
-> Zip a [(a, b)]
-> [(a, b)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Zip a [(a, b)] -> [(a, b)]) -> Zip a [(a, b)] -> [(a, b)]
forall {a} {b}. a -> (Zip a b -> b) -> Zip a b -> b
xf Zip a [(a, b)] -> [(a, b)]
forall {p} {a}. p -> [a]
xb [a]
xs ((a -> (Zip a [(a, b)] -> [(a, b)]) -> [(a, b)]) -> Zip a [(a, b)]
forall a b. (a -> (Zip a b -> b) -> b) -> Zip a b
Zip ((b
 -> (a -> (Zip a [(a, b)] -> [(a, b)]) -> [(a, b)])
 -> a
 -> (Zip a [(a, b)] -> [(a, b)])
 -> [(a, b)])
-> (a -> (Zip a [(a, b)] -> [(a, b)]) -> [(a, b)])
-> [b]
-> a
-> (Zip a [(a, b)] -> [(a, b)])
-> [(a, b)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b
-> (a -> (Zip a [(a, b)] -> [(a, b)]) -> [(a, b)])
-> a
-> (Zip a [(a, b)] -> [(a, b)])
-> [(a, b)]
forall {b} {a} {b} {a}.
b
-> (a -> (Zip a b -> b) -> b)
-> a
-> (Zip a b -> [(a, b)])
-> [(a, b)]
yf a -> (Zip a [(a, b)] -> [(a, b)]) -> [(a, b)]
forall {p} {p} {a}. p -> p -> [a]
yb [b]
ys))
  where
    xf :: a -> (Zip a b -> b) -> Zip a b -> b
xf a
x Zip a b -> b
xk Zip a b
yk = Zip a b -> a -> (Zip a b -> b) -> b
forall a b. Zip a b -> a -> (Zip a b -> b) -> b
runZip Zip a b
yk a
x Zip a b -> b
xk
    xb :: p -> [a]
xb p
_ = []

    yf :: b
-> (a -> (Zip a b -> b) -> b)
-> a
-> (Zip a b -> [(a, b)])
-> [(a, b)]
yf b
y a -> (Zip a b -> b) -> b
yk a
x Zip a b -> [(a, b)]
xk = (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: Zip a b -> [(a, b)]
xk ((a -> (Zip a b -> b) -> b) -> Zip a b
forall a b. (a -> (Zip a b -> b) -> b) -> Zip a b
Zip a -> (Zip a b -> b) -> b
yk)
    yb :: p -> p -> [a]
yb p
_ p
_ = []


-- | Zip from fold.
--
-- >>> zip' [1,2,3] [4,5,6]
-- [(1,4),(2,5),(3,6)]
--
-- >>> zip' "abc" []
-- []
--
-- >>> zip' [] "abc"
-- []
zip' :: [a] -> [b] -> [(a,b)]
zip' :: forall a b. [a] -> [b] -> [(a, b)]
zip' = (a -> ([b] -> [(a, b)]) -> [b] -> [(a, b)])
-> ([b] -> [(a, b)]) -> [a] -> [b] -> [(a, b)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([b] -> [(a, b)]) -> [b] -> [(a, b)]
forall {a} {b}. a -> ([b] -> [(a, b)]) -> [b] -> [(a, b)]
go ([(a, b)] -> [b] -> [(a, b)]
forall a b. a -> b -> a
const [])
  where
    go :: a -> ([b] -> [(a, b)]) -> [b] -> [(a, b)]
go a
_ [b] -> [(a, b)]
_ []     = []
    go a
x [b] -> [(a, b)]
f (b
y:[b]
ys) = (a
x, b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [b] -> [(a, b)]
f [b]
ys