Is there a way to draw a level tree?

GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]

TreeForm[expr /. List -> (List[List, ##] &)]

rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600,  VertexSize -> Medium]

Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:

g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
  VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]

newedges = # \[DirectedEdge] 
    {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@ 
   Select[VertexList[g1], Head[#[[1]]] === Symbol &];
VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]