Cycle function expressed as anamorphism

exo.hs

import Prelude hiding (cycle)

newtype Mu f = Mu (f (Mu f))

data Cons a b
    = Nil
    | Cons a b

instance Functor (Cons a) where
    fmap _ Nil        = Nil
    fmap f (Cons a b) = Cons a (f b)

unMu :: Mu f -> f (Mu f)
unMu (Mu m) = m

-- | Catamorphism
cata :: Functor f => (f b -> b) -> Mu f -> b
cata k = k . fmap (cata k) . unMu

-- | Anamorphism
ana :: Functor f => (b -> f b) -> b -> Mu f
ana k = Mu . fmap (ana k) . k

----------------
-- | List
----------------
type List a = Mu (Cons a)

list :: b -> (Cons a (List a) -> b) -> List a -> b
list b k (Mu c)
    = case c of
    Nil -> b
    _   -> k c

cons :: a
     -> List a
     -> List a
cons a as = Mu $ Cons a as

nil :: List a
nil = Mu Nil

-- | Same broken behavior of Prelude.cycle
cycle :: List a -> List a
cycle seed@(Mu c)
    = case c of
    Nil              -> error "cycle: empty list"
    start@(Cons _ _) -> ana (list start id) seed

----------------
-- | Utility
----------------
printList :: Show a => List a -> IO ()
printList xs
    = do putStr "["
         cata go xs $ False
  where
    go Nil _ = putStr "]"
    go (Cons a k) hasAncestor
        | hasAncestor = putStr ", " >> putStr (show a) >>  k hasAncestor
        | otherwise   = putStr (show a) >> k True

----------------
-- | Test
----------------
_123 :: List Int
_123 = cons 1 (cons 2 (cons 3 nil))

test = printList $ cycle _123