module Data.Zip.FoldL
( Fold(..), cfoldl, cfoldl'
, WithCont , FoldC , cfoldlc
, WithCont', FoldC', cfoldlc'
, Pair'(..), P
) where
import Data.Monoid
import Control.Applicative
import Data.List (foldl')
import Data.Pair
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 Pair (Fold b) where pair = 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 Pair' (Fold b) where pair' = 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 Pair (h b) => Applicative (WithCont h b) where
pure a = WC (error "unneeded pre-cont") (pure a)
WC f k <*> WC f' k' =
WC (f `pair` f') (\ (a,a') -> (k a) (k' 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 Pair' (h b) => Applicative (WithCont' h b) where
pure a = WC' (error "unneeded pre-cont") (pure a)
WC' f k <*> WC' f' k' =
WC' (f `pair'` f') (\ (P a a') -> (k a) (k' 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 Pair' f where
pair' :: f a -> f b -> f (P a b)
instance Pair' [] where pair' = liftA2 P
instance Monoid u => Pair' ((,) u) where pair' = liftA2 P
instance Pair' ((->) u) where pair' = liftA2 P
instance Pair' IO where pair' = liftA2 P