    {-# LANGUAGE CPP #-}
    module Control.Monad.Free.Zip (zipFree, zipFree_) where

    import Control.Monad.Free
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.State
    import Data.Foldable
    import Data.Traversable as T
    import Prelude hiding (fail)

    zipFree
      :: (Traversable f, Eq (f ()), MonadFail m)
      => (Free f a -> Free f b -> m (Free f c))
      -> Free f a
      -> Free f b
      -> m (Free f c)
    zipFree :: forall (f :: * -> *) (m :: * -> *) a b c.
    (Traversable f, Eq (f ()), MonadFail m) =>
    (Free f a -> Free f b -> m (Free f c))
    -> Free f a -> Free f b -> m (Free f c)
    zipFree Free f a -> Free f b -> m (Free f c)
    f (Impure f (Free f a)
    a) (Impure f (Free f b)
    b)
      | (Free f a -> ()) -> f (Free f a) -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Free f a -> ()
    forall a b. a -> b -> a
    const ()) f (Free f a)
    a f () -> f () -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Free f b -> ()) -> f (Free f b) -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Free f b -> ()
    forall a b. a -> b -> a
    const ()) f (Free f b)
    b = f (Free f c) -> Free f c
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Impure (f (Free f c) -> Free f c) -> m (f (Free f c)) -> m (Free f c)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` (Free f a -> Free f b -> m (Free f c))
    -> f (Free f a) -> f (Free f b) -> m (f (Free f c))
    forall (t1 :: * -> *) (t2 :: * -> *) (m :: * -> *) a b c.
    (Traversable t1, Traversable t2, Monad m, MonadFail m) =>
    (a -> b -> m c) -> t1 a -> t2 b -> m (t2 c)
    unsafeZipWithG Free f a -> Free f b -> m (Free f c)
    f f (Free f a)
    a f (Free f b)
    b
    zipFree Free f a -> Free f b -> m (Free f c)
    _ Free f a
    _ Free f b
    _ = String -> m (Free f c)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "zipFree: structure mistmatch"

    zipFree_
      :: (Traversable f, Eq (f ()), MonadFail m)
      => (Free f a -> Free f b -> m ()) -> Free f a -> Free f b -> m ()
    zipFree_ :: forall (f :: * -> *) (m :: * -> *) a b.
    (Traversable f, Eq (f ()), MonadFail m) =>
    (Free f a -> Free f b -> m ()) -> Free f a -> Free f b -> m ()
    zipFree_ Free f a -> Free f b -> m ()
    f (Impure f (Free f a)
    a) (Impure f (Free f b)
    b)
      | (Free f a -> ()) -> f (Free f a) -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Free f a -> ()
    forall a b. a -> b -> a
    const ()) f (Free f a)
    a f () -> f () -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Free f b -> ()) -> f (Free f b) -> f ()
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Free f b -> ()
    forall a b. a -> b -> a
    const ()) f (Free f b)
    b = (Free f a -> Free f b -> m ()) -> [Free f a] -> [Free f b] -> m ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ Free f a -> Free f b -> m ()
    f (f (Free f a) -> [Free f a]
    forall a. f a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList f (Free f a)
    a) (f (Free f b) -> [Free f b]
    forall a. f a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList f (Free f b)
    b)
    zipFree_ Free f a -> Free f b -> m ()
    _ Free f a
    _ Free f b
    _ = String -> m ()
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "zipFree_: structure mismatch"

    unsafeZipWithG
      :: (Traversable t1, Traversable t2, Monad m, MonadFail m)
      => (a -> b -> m c) -> t1 a -> t2 b -> m (t2 c)
    unsafeZipWithG :: forall (t1 :: * -> *) (t2 :: * -> *) (m :: * -> *) a b c.
    (Traversable t1, Traversable t2, Monad m, MonadFail m) =>
    (a -> b -> m c) -> t1 a -> t2 b -> m (t2 c)
    unsafeZipWithG a -> b -> m c
    f t1 a
    t1 t2 b
    t2  = StateT [a] m (t2 c) -> [a] -> m (t2 c)
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ((b -> StateT [a] m c) -> t2 b -> StateT [a] m (t2 c)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> t2 a -> m (t2 b)
    T.mapM b -> StateT [a] m c
    zipG' t2 b
    t2) (t1 a -> [a]
    forall a. t1 a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList t1 a
    t1)
           where zipG' :: b -> StateT [a] m c
    zipG' b
    y = do (x:xx) <- StateT [a] m [a]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
                              put xx
                              lift (f x y)