SES (shortest edit script) implemented as a dynamorphism

SES.hs

dyna :: Functor f => (f (Cofree f a) -> a) -> (c -> f c) -> c -> a
dyna a c = extract . h
  where h = cofree . uncurry (:<) . (a &&& identity) . fmap h . c

ses :: Eq a => [a] -> [a] -> [These a a]
ses as bs = dyna (selectBest . edges (length as)) (editGraph as) (as, bs)

-- | A vertex in the edit graph.
data Vertex a x = Vertex { xs :: [a], ys :: [a], next :: Maybe x }
  deriving (Eq, Functor, Show)

data Edges a x
  = XY a a x x x
  | X a x
  | Y a x
  deriving (Eq, Functor, Show)

-- | Populate the edit graph in row-major order.
editGraph :: [a] -> ([a], [a]) -> Vertex a ([a], [a])
editGraph cs (xs, ys) = case (xs, ys) of
  ([], [])   -> Vertex []    []      Nothing
  ([], b:bs) -> Vertex []    (b:bs) (Just (cs, bs))
  (a:as, bs) -> Vertex (a:as) bs    (Just (as, bs))

-- | Compute the available edges for a given vertex.
edges :: Int -> Vertex a (Cofree (Vertex a) x) -> Maybe (Edges a x)
edges n vertex = case vertex of
  Vertex _  _   Nothing -> Nothing
  Vertex xs ys (Just v)
    | a:_ <- xs
    , b:_ <- ys -> Just (XY a b (x v) (y v) (xy v))
    | a:_ <- xs -> Just (X  a   (x v))
    | b:_ <- ys -> Just (Y    b       (y v))
    | otherwise -> Nothing
  where x  = extract
        y  = extract . at  n
        xy = extract . at (n + 1)

-- | Construct the edit script from the available edges.
selectBest :: Eq a => Maybe (Edges a [These a a]) -> [These a a]
selectBest Nothing = []
selectBest (Just edges) = case edges of
  XY a b x1 x2 x3
    | a == b                            -> These a b : x3
    | editDistance x1 < editDistance x2 -> This  a   : x1
    | otherwise                         -> That    b : x2
  X a x1                                -> This  a   : x1
  Y b x2                                -> That    b : x2
  where editDistance = sum . fmap (these (const 1) (const 1) (const (const (0 :: Int))))

at :: Int -> Cofree (Vertex a) x -> Cofree (Vertex a) x
at n x = iterate at' x !! n
  where at' x = case unwrap x of
          Vertex _ _ (Just x') -> x'
          _ -> x -- wtf