BezierCurve in EdgeShapeFunction fails when used on multiedges graph

As I said in my comment:

The problem is that for loops, Graph is creating curved edges. Therefore, the edges are not just {point1, point2} type Lines. Ultimately your problem is your replacement rule, which is not well suited for such lists.

You can check that the EdgeShapeFunction is passed all the points, not only the initial ones:

pts = {1 -> 2, 2 -> 1, 2 -> 3, 3 -> 1};
Graph[pts, VertexLabels -> Placed["Name", Center], 
           EdgeShapeFunction -> ((Print[Short[#]]; Line[#1]) &)]
{{0.496922,0.},{0.518107,0.109873},<<15>>,{0.999994,0.864245}}
{{0.999994,0.864245},{0.978809,0.754372},<<15>>,{0.496922,0.}}
{{0.999994,0.864245},{0.,0.867795}}
{{0.,0.867795},{0.496922,0.}}

So, keeping that in mind, you can write the proper function, for example:

edgeFun[pts_, e__] := BezierCurve[{#, # - {0, 1}, #2} & @@ pts[[{1, -1}]]];

pts = {1 -> 2, 2 -> 1, 2 -> 3, 3 -> 1};
Graph[pts, VertexLabels -> Placed["Name", Center], EdgeShapeFunction -> edgeFun]

Mathematica graphics


An alternative is to use "CurvedArc" as the EdgeShapeFunction:

Graph[pts, VertexLabels -> Placed["Name", Center], VertexSize -> Medium, 
 EdgeShapeFunction -> GraphElementData[{"CurvedArc", "Curvature" -> -3/2}]]

enter image description here

Graph[pts1, VertexLabels -> Placed["Name", Center], VertexSize -> Medium, 
 EdgeShapeFunction -> GraphElementData[{"CurvedArc", "Curvature" -> -3/2}]]

enter image description here


Just to be redundant, I think your patterns need tuning for the extra points sent by multiple edges:

{{0, 0}, {1, 2}} /. {a_, b_} :> {"a is " <> ToString[a], "b is " <> ToString[b]}

{"a is {0, 0}", "b is {1, 2}"}

{{0, 0}, {1, 1}, {2, 2}, {3, 3}} /. {a_, b_} :> {"a is " <> ToString[a], "b is " <> ToString[b]}

{{"a is 0", "b is 0"}, {"a is 1", "b is 1"}, {"a is 2", "b is 2"}, {"a is 3", "b is 3"}}