Cleaned up code for http://stackoverflow.com/a/23768724/482696

trav.hs

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Category
import Data.Traversable
import Data.Tree
import Control.Comonad
import Data.List.NonEmpty

trav :: Eq a => (Traversable t, Comonad t) => [a] -> t a -> [a]
trav [] _ = []
trav p@(s0:ss0) w
    | extract w /= s0 = p
    | otherwise = case traverse (step ss0) (duplicate w) of
                       Left ss1 -> ss1
                       Right _  -> p
  where
    step [] = const $ Right ()
    step (s:ss) = trav ss >>> \case
        (s':_) | s' == s -> Right ()
        ss2 -> Left ss2

path = ['a', 'b', 'c', 'd', 'e']

tree = Node 'a' [Node 'x' [], Node 'c' [Node 'z' [Node 'd' []]]]

list = 'a' :| ['b', 'c', 'd', 'x', 'e']

main :: IO ()
main = do print $ trav path tree
          print $ trav path list