module Data.Zip.FoldL
( FoldL(..), cfoldl, cfoldl', unitL
, WithCont , FoldLC , cfoldlc
, WithCont', FoldLC', cfoldlc'
, Zip'(..), P(..)
) where
import Prelude hiding (zip)
import Data.Monoid
import Control.Applicative
import Data.List (foldl')
import Data.Zip
import Data.WithCont
data FoldL b a = F (a -> b -> a) a
unitL :: FoldL b ()
unitL = F const ()
cfoldl :: FoldL b a -> [b] -> a
cfoldl ~(F op e) = foldl op e
zipF :: FoldL b a -> FoldL b a' -> FoldL 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 (FoldL b) where zip = zipF
cfoldl' :: FoldL b a -> [b] -> a
cfoldl' (F op e) = foldl' op e
zipF' :: FoldL b a -> FoldL b a' -> FoldL 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' (FoldL b) where zip' = zipF'
type FoldLC b = WithCont (FoldL b)
cfoldlc :: FoldLC b a -> [b] -> a
cfoldlc (WC f k) = fmap k (cfoldl f)
data WithCont' z c = forall a. WC' (z a) (a -> c)
instance Functor (WithCont' z) where
fmap g (WC' f k) = WC' f (fmap g k)
instance Zip' z => Applicative (WithCont' z) 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 FoldLC' b = WithCont' (FoldL b)
cfoldlc' :: FoldLC' 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