EdgeContract when vertex names are lists

Question

Graphs often compress a great deal of information into a simple visualizable structure. So it is not uncommon that vertex labels include more information than a simple index. For example, vertex labels might be lists. Graph handles this brilliantly:

graph = Graph[{{1, 2} \[DirectedEdge] {1, 3},
               {1, 3} \[DirectedEdge] {2, 3}, 
               {2, 3} \[DirectedEdge] {3, 2},
               {3, 2} \[DirectedEdge] {1, 2}}, VertexLabels -> "Name"] 

Nicely yields the graph

The issue here is EdgeContract. It does not seem to operate on such graphs. For example:

EdgeContract[graph, First[EdgeList[graph]]]

returns exactly the same graph. It does not contract the first edge.

Answer 1

One work-around is to covert the vertex names into strings:

sgraph = Graph[Map[ToString[First[#]] \[DirectedEdge] ToString[Last[#]] &, 
                    EdgeList[graph]], VertexLabels -> "Name"]

(I'm sure someone has a more elegant method for doing this) That produces the same graph but with the vertex names as strings instead of lists.

Now EdgeContract works:

EdgeContract[sgraph, First[EdgeList[sgraph]]]

correctly yields:

I suppose another alternative is a dictionary that maps labels to their information. But wouldn't it be nice if this added step weren't required?