{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Functor.Internal.Mutual
-- Copyright   :  (C) 2008 Edward Kmett, (C) 2024 Koji Miyazato
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Koji Miyazato <viercc@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
module Control.Functor.Internal.Mutual where

import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable

newtype Mutual p m n a = Mutual {forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
Mutual p m n a -> m (p a (Mutual p n m a))
runMutual :: m (p a (Mutual p n m a))}

deriving instance (Eq (m (p a (Mutual p n m a))), Eq (n (p a (Mutual p m n a)))) => Eq (Mutual p n m a)
deriving instance (Show (m (p a (Mutual p n m a))), Show (n (p a (Mutual p m n a)))) => Show (Mutual p n m a)

instance (Bifunctor p, Functor m, Functor n) => Functor (Mutual p m n) where
  fmap :: forall a b. (a -> b) -> Mutual p m n a -> Mutual p m n b
fmap a -> b
f = m (p b (Mutual p n m b)) -> Mutual p m n b
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
m (p a (Mutual p n m a)) -> Mutual p m n a
Mutual (m (p b (Mutual p n m b)) -> Mutual p m n b)
-> (Mutual p m n a -> m (p b (Mutual p n m b)))
-> Mutual p m n a
-> Mutual p m n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a (Mutual p n m a) -> p b (Mutual p n m b))
-> m (p a (Mutual p n m a)) -> m (p b (Mutual p n m b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (Mutual p n m a -> Mutual p n m b)
-> p a (Mutual p n m a)
-> p b (Mutual p n m b)
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((a -> b) -> Mutual p n m a -> Mutual p n m b
forall a b. (a -> b) -> Mutual p n m a -> Mutual p n m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (m (p a (Mutual p n m a)) -> m (p b (Mutual p n m b)))
-> (Mutual p m n a -> m (p a (Mutual p n m a)))
-> Mutual p m n a
-> m (p b (Mutual p n m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutual p m n a -> m (p a (Mutual p n m a))
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
Mutual p m n a -> m (p a (Mutual p n m a))
runMutual

instance (Bifoldable p, Foldable m, Foldable n) => Foldable (Mutual p m n) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Mutual p m n a -> m
foldMap a -> m
f = (p a (Mutual p n m a) -> m) -> m (p a (Mutual p n m a)) -> m
forall m a. Monoid m => (a -> m) -> m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (Mutual p n m a -> m) -> p a (Mutual p n m a) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f ((a -> m) -> Mutual p n m a -> m
forall m a. Monoid m => (a -> m) -> Mutual p n m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) (m (p a (Mutual p n m a)) -> m)
-> (Mutual p m n a -> m (p a (Mutual p n m a)))
-> Mutual p m n a
-> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutual p m n a -> m (p a (Mutual p n m a))
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
Mutual p m n a -> m (p a (Mutual p n m a))
runMutual

instance (Bitraversable p, Traversable m, Traversable n) => Traversable (Mutual p m n) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mutual p m n a -> f (Mutual p m n b)
traverse a -> f b
f = (m (p b (Mutual p n m b)) -> Mutual p m n b)
-> f (m (p b (Mutual p n m b))) -> f (Mutual p m n b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (p b (Mutual p n m b)) -> Mutual p m n b
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
m (p a (Mutual p n m a)) -> Mutual p m n a
Mutual (f (m (p b (Mutual p n m b))) -> f (Mutual p m n b))
-> (Mutual p m n a -> f (m (p b (Mutual p n m b))))
-> Mutual p m n a
-> f (Mutual p m n b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a (Mutual p n m a) -> f (p b (Mutual p n m b)))
-> m (p a (Mutual p n m a)) -> f (m (p b (Mutual p n m b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> m a -> f (m b)
traverse ((a -> f b)
-> (Mutual p n m a -> f (Mutual p n m b))
-> p a (Mutual p n m a)
-> f (p b (Mutual p n m b))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> p a b -> f (p c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f ((a -> f b) -> Mutual p n m a -> f (Mutual p n m b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mutual p n m a -> f (Mutual p n m b)
traverse a -> f b
f)) (m (p a (Mutual p n m a)) -> f (m (p b (Mutual p n m b))))
-> (Mutual p m n a -> m (p a (Mutual p n m a)))
-> Mutual p m n a
-> f (m (p b (Mutual p n m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutual p m n a -> m (p a (Mutual p n m a))
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
Mutual p m n a -> m (p a (Mutual p n m a))
runMutual

foldMutual
  :: Bifunctor p
  => (forall a b. t a -> (a -> p b (t b)) -> t b)
  -> (forall a. m a -> t a)
  -> (forall a. n a -> t a)
  -> Mutual p m n c -> t c
foldMutual :: forall (p :: * -> * -> *) (t :: * -> *) (m :: * -> *) (n :: * -> *)
       c.
Bifunctor p =>
(forall a b. t a -> (a -> p b (t b)) -> t b)
-> (forall a. m a -> t a)
-> (forall a. n a -> t a)
-> Mutual p m n c
-> t c
foldMutual forall a b. t a -> (a -> p b (t b)) -> t b
bind forall a. m a -> t a
mt forall a. n a -> t a
nt = (t (p c (Mutual p n m c))
-> (p c (Mutual p n m c) -> p c (t c)) -> t c
forall a b. t a -> (a -> p b (t b)) -> t b
`bind` (Mutual p n m c -> t c) -> p c (Mutual p n m c) -> p c (t c)
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall a b. t a -> (a -> p b (t b)) -> t b)
-> (forall a. n a -> t a)
-> (forall a. m a -> t a)
-> Mutual p n m c
-> t c
forall (p :: * -> * -> *) (t :: * -> *) (m :: * -> *) (n :: * -> *)
       c.
Bifunctor p =>
(forall a b. t a -> (a -> p b (t b)) -> t b)
-> (forall a. m a -> t a)
-> (forall a. n a -> t a)
-> Mutual p m n c
-> t c
foldMutual t a -> (a -> p b (t b)) -> t b
forall a b. t a -> (a -> p b (t b)) -> t b
bind n a -> t a
forall a. n a -> t a
nt m a -> t a
forall a. m a -> t a
mt)) (t (p c (Mutual p n m c)) -> t c)
-> (Mutual p m n c -> t (p c (Mutual p n m c)))
-> Mutual p m n c
-> t c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (p c (Mutual p n m c)) -> t (p c (Mutual p n m c))
forall a. m a -> t a
mt (m (p c (Mutual p n m c)) -> t (p c (Mutual p n m c)))
-> (Mutual p m n c -> m (p c (Mutual p n m c)))
-> Mutual p m n c
-> t (p c (Mutual p n m c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutual p m n c -> m (p c (Mutual p n m c))
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
Mutual p m n a -> m (p a (Mutual p n m a))
runMutual

unfoldMutual
  :: Bifunctor p
  => (forall a b. (p a (s a) -> b) -> s a -> s b)
  -> (forall a. s a -> w a)
  -> (forall a. s a -> v a)
  -> s c -> Mutual p w v c
unfoldMutual :: forall (p :: * -> * -> *) (s :: * -> *) (w :: * -> *) (v :: * -> *)
       c.
Bifunctor p =>
(forall a b. (p a (s a) -> b) -> s a -> s b)
-> (forall a. s a -> w a)
-> (forall a. s a -> v a)
-> s c
-> Mutual p w v c
unfoldMutual forall a b. (p a (s a) -> b) -> s a -> s b
ext forall a. s a -> w a
sw forall a. s a -> v a
sv = w (p c (Mutual p v w c)) -> Mutual p w v c
forall (p :: * -> * -> *) (m :: * -> *) (n :: * -> *) a.
m (p a (Mutual p n m a)) -> Mutual p m n a
Mutual (w (p c (Mutual p v w c)) -> Mutual p w v c)
-> (s c -> w (p c (Mutual p v w c))) -> s c -> Mutual p w v c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s (p c (Mutual p v w c)) -> w (p c (Mutual p v w c))
forall a. s a -> w a
sw (s (p c (Mutual p v w c)) -> w (p c (Mutual p v w c)))
-> (s c -> s (p c (Mutual p v w c)))
-> s c
-> w (p c (Mutual p v w c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p c (s c) -> p c (Mutual p v w c))
-> s c -> s (p c (Mutual p v w c))
forall a b. (p a (s a) -> b) -> s a -> s b
ext ((s c -> Mutual p v w c) -> p c (s c) -> p c (Mutual p v w c)
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((forall a b. (p a (s a) -> b) -> s a -> s b)
-> (forall a. s a -> v a)
-> (forall a. s a -> w a)
-> s c
-> Mutual p v w c
forall (p :: * -> * -> *) (s :: * -> *) (w :: * -> *) (v :: * -> *)
       c.
Bifunctor p =>
(forall a b. (p a (s a) -> b) -> s a -> s b)
-> (forall a. s a -> w a)
-> (forall a. s a -> v a)
-> s c
-> Mutual p w v c
unfoldMutual (p a (s a) -> b) -> s a -> s b
forall a b. (p a (s a) -> b) -> s a -> s b
ext s a -> v a
forall a. s a -> v a
sv s a -> w a
forall a. s a -> w a
sw))