Apomorphisms in Haskell

apomorphisms.hs

newtype Term f = In { out :: f (Term f) }

-- The trivial one
type RCoalgebra1 f a = a -> f (Either (Term f) a)

apo1 :: Functor f => RCoalgebra1 f a -> a -> Term f
apo1 f = In . (fmap fanin) . f
	where fanin = either id (apo1 f)


-- The pretty one
type RCoalgebra2 f a = a -> Either (f (Term f)) (f a)

apo2 :: Functor f => RCoalgebra2 f a -> a -> Term f
apo2 f = In . either id (fmap $ apo2 f) . f


-- The messed up one
type RCoalgebra3 f a = Either (a -> f (Term f)) (a -> f a)
-- See, we _meant_ “at every step, either f produces f (Term f) and we halt or it produces f a and we continue”
-- But we _said_ “Either f produces f (Term f) and we halt, or f a and we continue, and it’s called at every step”
-- I.e. it doesn’t decide at every step; it decides once, for all steps, and we diverge or fast-exit. Useless.

apo3 :: Functor f => RCoalgebra3 f a -> a -> Term f
apo3 f t = In $ either ($ t) doit f
	where doit g = fmap (apo3 f) (g t)