module Data.Zip.FoldL
( Fold(..), cfoldl, cfoldl'
, WithCont , FoldC , cfoldlc
, WithCont', FoldC', cfoldlc'
, Zip'(..), P
) where
import Prelude hiding (zip)
import Data.Monoid
import Control.Applicative
import Data.List (foldl')
import Data.Zip
data Fold b a = F (a -> b -> a) a
cfoldl :: Fold b a -> [b] -> a
cfoldl (F op e) = foldl op e
zipF :: Fold b a -> Fold b a' -> Fold b (a,a')
F op e `zipF` F op' e' = F op'' (e,e')
where
(a,a') `op''` b = (a `op` b, a' `op'` b)
instance Zip (Fold b) where zip = zipF
cfoldl' :: Fold b a -> [b] -> a
cfoldl' (F op e) = foldl' op e
zipF' :: Fold b a -> Fold b a' -> Fold b (P a a')
F op e `zipF'` F op' e' = F op'' (P e e')
where
P a a' `op''` b = P (a `op` b) (a' `op'` b)
instance Zip' (Fold b) where zip' = zipF'
data WithCont h b c = forall a. WC (h b a) (a -> c)
instance Functor (WithCont h b) where
fmap g (WC f k) = WC f (fmap g k)
instance Zip (h b) => Applicative (WithCont h b) where
pure a = WC (error "unneeded pre-cont") (pure a)
WC hf hk <*> WC xf xk =
WC (hf `zip` xf) (\ (a,a') -> (hk a) (xk a'))
type FoldC = WithCont Fold
cfoldlc :: FoldC b a -> [b] -> a
cfoldlc (WC f k) = fmap k (cfoldl f)
data WithCont' h b c = forall a. WC' (h b a) (a -> c)
instance Functor (WithCont' h b) where
fmap g (WC' f k) = WC' f (fmap g k)
instance Zip' (h b) => Applicative (WithCont' h b) where
pure a = WC' (error "unneeded pre-cont") (pure a)
WC' hf hk <*> WC' xf xk =
WC' (hf `zip'` xf) (\ (P a a') -> (hk a) (xk a'))
type FoldC' = WithCont' Fold
cfoldlc' :: FoldC' b a -> [b] -> a
cfoldlc' (WC' f k) = fmap k (cfoldl' f)
data P c c' = P !c !c'
class Zip' f where
zip' :: f a -> f b -> f (P a b)
instance Zip' [] where zip' = liftA2 P
instance Monoid u => Zip' ((,) u) where zip' = liftA2 P
instance Zip' ((->) u) where zip' = liftA2 P
instance Zip' IO where zip' = liftA2 P