content: stableMatching :: Eq a => State a -> [Couple a]
  stableMatching = getPairs . until (null._freeGuys) step
    where
      getPairs s = map (_2 %~ head) $ s^.guys
  
  step :: Eq a => State a -> State a
  step s = foldl propose s (s^.freeGuys)
    where
      propose s guy =
        let girl                = s^.fianceesOf guy & head
            bestGuy : otherGuys = s^.fiancesOf girl
            modify
              | guy == bestGuy       = freeGuys %~ delete guy
              | guy `elem` otherGuys = (fiancesOf girl %~ dropWhile (/= guy)) .
                                       (freeGuys %~ guy `replaceBy` bestGuy)
              | otherwise            = fianceesOf guy %~ tail
        in modify s
  
      replaceBy x y [] = []
      replaceBy x y (h:t) | h == x = y:t
                          | otherwise = h:replaceBy x y t
  
  unstablePairs :: Eq a => State a -> [Couple a] -> [(Couple a, Couple a)]
  unstablePairs s pairs =
    [ ((m1, w1), (m2,w2)) | (m1, w1) <- pairs
                          , (m2,w2) <- pairs
                          , m1 /= m2
                          , let fm = s^.fianceesOf m1
                          , elemIndex w2 fm < elemIndex w1 fm
                          , let fw = s^.fiancesOf w2
                          , elemIndex m2 fw < elemIndex m1 fw ]
  