module Control.Functor.Zip
( unfzip, unbizip
, counzip, counbizip
, Zip(..)
, Bizip(..)
, Cozip(..)
) where
import Prelude hiding ((.),id,fst,snd)
import Control.Category
import Control.Category.Hask
import Control.Category.Cartesian
import Control.Functor
import Control.Functor.Fix
import Control.Functor.Combinators.Biff
import Control.Monad.Identity
import Data.Monoid (Monoid(..))
unfzip :: Functor f => f (a, b) -> (f a, f b)
unfzip = fmap fst &&& fmap snd
unbizip :: (PreCartesian r pr , PreCartesian s ps, PreCartesian t pt, Bifunctor p r s t) =>
t (p (pr a c) (ps b d)) (pt (p a b) (p c d))
unbizip = bimap fst fst &&& bimap snd snd
class Functor f => Zip f where
fzip :: f a -> f b -> f (a, b)
fzip = fzipWith (,)
fzipWith :: (a -> b -> c) -> f a -> f b -> f c
fzipWith f as bs = fmap (uncurry f) (fzip as bs)
class Bifunctor p Hask Hask Hask => Bizip p where
bizip :: p a c -> p b d -> p (a,b) (c,d)
bizip = bizipWith (,) (,)
bizipWith :: (a -> b -> e) -> (c -> d -> f) -> p a c -> p b d -> p e f
bizipWith f g as bs = bimap (uncurry f) (uncurry g) (bizip as bs)
instance Zip Identity where
fzipWith f (Identity a) (Identity b) = Identity (f a b)
instance Zip [] where
fzip = zip
fzipWith = zipWith
instance Zip Maybe where
fzipWith f (Just a) (Just b) = Just (f a b)
fzipWith _ _ _ = Nothing
instance Monoid a => Zip ((,)a) where
fzipWith f (a, c) (b, d) = (mappend a b, f c d)
instance Bizip (,) where
bizipWith f g (a,b) (c,d) = (f a c, g b d)
instance (Bizip p, Zip f, Zip g) => Bizip (Biff p f g) where
bizipWith f g as bs = Biff $ bizipWith (fzipWith f) (fzipWith g) (runBiff as) (runBiff bs)
instance Bizip p => Zip (Fix p) where
fzipWith f as bs = InB $ bizipWith f (fzipWith f) (outB as) (outB bs)
instance Monoid a => Zip (Either a) where
fzipWith _ (Left a) (Left b) = Left (mappend a b)
fzipWith _ (Right _) (Left b) = Left b
fzipWith _ (Left a) (Right _) = Left a
fzipWith f (Right a) (Right b) = Right (f a b)
counzip :: Functor f => Either (f a) (f b) -> f (Either a b)
counzip = fmap Left ||| fmap Right
counbizip :: (PreCoCartesian r sr, PreCoCartesian s ss, PreCoCartesian t st, Bifunctor q r s t) =>
t (st (q a c) (q b d)) (q (sr a b) (ss c d))
counbizip = bimap inl inl ||| bimap inr inr
class Functor f => Cozip f where
cozip :: f (Either a b) -> Either (f a) (f b)
instance Cozip Identity where
cozip = bimap Identity Identity . runIdentity
instance Cozip ((,)c) where
cozip (c,ab) = bimap ((,)c) ((,)c) ab
instance Cozip Maybe where
cozip = maybe (Left Nothing) (bimap Just Just)
instance Cozip (Either c) where
cozip = (Left . Left) ||| bimap Right Right