```{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Morphism.Synchro
-- Copyright   :  (C) 2008 Edward Kmett
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (rank-2 polymorphism)
--
-- Martin Erwig's synchromorphisms.
----------------------------------------------------------------------------
module Control.Morphism.Synchro where

import Control.Category.Cartesian ((&&&))
import Control.Functor
import Control.Functor.Algebra

-- | @synchro d' f d g1 g2 d''@ is Martin Erwig's @d,d''-synchromorphism to d'@. Mostly useful for graph algorithms.
synchro ::
Bialgebra m n c ->
(h x (Either a c) -> m c) ->
Trialgebra (f x) (g x) (h x) a ->
((h x a, b) -> k x b) ->
((h x a, j x b) -> h x (Either a (g x a, b))) ->
Bialgebra (k x) (j x) b ->
(g x a, b) -> c

--             g1
-- h = D' <- D <-> D''
--       f     g2
-- dfs = List <- Graph <-> Stack -- depth-first search
-- bfs = List <- Graph <-> Queue -- breadth-first search

synchro d' f d g1 g2 d'' = h where
h = fst d' . f . second (second h) . g2 . (fst &&& (snd d'' . fst d'' . g1)) . first (snd d)
-- (g x a, b) 			>- first (snd d)  ->
-- (h x a, b) 			>- (fst &&& g1) ->
-- (h x a, k x b) 		>- second (fst d'') ->
-- (h x a, b) 			>- second (snd d'') ->
-- (h x a, j x b)		>- g2 ->
-- (h x (Either a (g x a, b)) 	>- second (second h) ->
-- (h x (Either a c))		>- f ->
-- m c				>- fst d'
-- c
```