From 8c02351376984147a3a630e1889e4d0095056aa6 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Sun, 20 Mar 2022 22:16:56 +0100 Subject: server: use fdp as dot layout mode (though apparently there's no way to set the -LC option? would look much nicer with that …) --- server/HtmlOrphans.hs | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) (limited to 'server/HtmlOrphans.hs') 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 -- cgit v1.2.3