server: use fdp as dot layout mode

(though apparently there's no way to set the -LC option? would look much
nicer with that …)

1 files changed, 19 insertions, 17 deletions

diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index 6438a5e..02bca23 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -145,7 +145,21 @@ instance ToHtml (DirResult a) where
 
     p_ $ do badge maxlevel "Linted:"; " "; headerText maxlevel
 
-    h3_ "Exits"
+    h2_ "Exits"
+
+    -- the exit graph thing
+    script_ [ src_ "/dot-wasm.js" ] (""::Text)
+    script_ [ src_ "/d3.js" ] (""::Text)
+    script_ [ src_ "/d3-graphviz.js" ] (""::Text)
+    div_ [ id_ "exitGraph" ] ""
+    script_ $
+      "\
+      \d3.select(\"#exitGraph\")\n\
+      \  .graphviz().engine(\"fdp\")\n\
+      \  .dot(\"" <> toText (escapeJSON $ toString dirresultGraph) <> "\")\n\
+      \  .render()\n\
+      \"
+
     unless (null dirresultDeps) $ ul_ $
       forM_ dirresultDeps $ \missing -> do
         li_ $ do
@@ -161,18 +175,6 @@ instance ToHtml (DirResult a) where
           ", but is used as "; mono "exitUrl"; " in "
           placeList (neededBy missing); "."
 
-    -- the exit graph thing
-    script_ [ src_ "/dot-wasm.js" ] (""::Text)
-    script_ [ src_ "/d3.js" ] (""::Text)
-    script_ [ src_ "/d3-graphviz.js" ] (""::Text)
-    div_ [ id_ "exitGraph" ] ""
-    script_ $
-      "\
-      \d3.select(\"#exitGraph\")\n\
-      \  .graphviz()\n\
-      \  .dot(\"" <> toText (escapeJSON $ toString dirresultGraph) <> "\")\n\
-      \  .render()\n\
-      \"
 
     unless (null dirresultMissingAssets) $ do
       h2_ [class_ "border-bottom"] "Assets"
@@ -182,16 +184,16 @@ instance ToHtml (DirResult a) where
           " does not exist, but is referenced in "; placeList neededBy; ")"
 
     unless (null dirresultMaps) $ do
-      h3_ "Maps"
+      h2_ "Maps"
       flip M.foldMapWithKey dirresultMaps $ \name MapResult { .. } -> do
-        h4_ (toHtml name)
+        h3_ (toHtml name)
         ul_ $ forM_ mapresultGeneral $ \lint ->
           li_ (toHtml lint)
         unless (null mapresultLayer) $ do
-          h5_ "Layers"
+          h4_ "Layers"
           ul_ (listMapWithKey mapresultLayer)
         unless (null mapresultTileset) $ do
-          h5_ "Tilesets"
+          h4_ "Tilesets"
           ul_ (listMapWithKey mapresultTileset)
 
     where