From 809e8ffdc3fd69d792d348cf94266eabbab15f12 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sun, 12 Jan 2025 12:15:09 -0800
Subject: [PATCH] render goals graph (#2289)

# Demo

1. In one console:
    ```
    scripts/play.sh -i data/scenarios/Challenges/bridge-building.yaml
   ```
2. In another console:
    ```
    scripts/gen/goals-graph.sh
    ```
3. View `goals.svg`:
    ![goals](https://github.com/user-attachments/assets/d6114c27-fde2-41ce-8c65-c52d3a9707de)
---
 scripts/gen/goals-graph.sh             |  5 +++++
 src/swarm-web/Swarm/Web.hs             | 10 ++++++++++
 src/swarm-web/Swarm/Web/GraphRender.hs | 27 ++++++++++++++++++++++++++
 swarm.cabal                            |  2 ++
 4 files changed, 44 insertions(+)
 create mode 100755 scripts/gen/goals-graph.sh
 create mode 100644 src/swarm-web/Swarm/Web/GraphRender.hs

diff --git a/scripts/gen/goals-graph.sh b/scripts/gen/goals-graph.sh
new file mode 100755
index 000000000..476c00129
--- /dev/null
+++ b/scripts/gen/goals-graph.sh
@@ -0,0 +1,5 @@
+#!/bin/bash -ex
+
+cd $(git rev-parse --show-toplevel)
+
+curl -s http://localhost:5357/goals/render | dot -Tsvg -o goals.svg
diff --git a/src/swarm-web/Swarm/Web.hs b/src/swarm-web/Swarm/Web.hs
index 735cb0cc6..8de9a7dc1 100644
--- a/src/swarm-web/Swarm/Web.hs
+++ b/src/swarm-web/Swarm/Web.hs
@@ -89,6 +89,7 @@ import Swarm.TUI.Model.UI
 import Swarm.TUI.Model.UI.Gameplay
 import Swarm.Util (applyJust)
 import Swarm.Util.RingBuffer
+import Swarm.Web.GraphRender
 import Swarm.Web.Worldview
 import System.Timeout (timeout)
 import Text.Read (readEither)
@@ -107,6 +108,7 @@ type SwarmAPI =
     :<|> "goals" :> "prereqs" :> Get '[JSON] [PrereqSatisfaction]
     :<|> "goals" :> "active" :> Get '[JSON] [Objective]
     :<|> "goals" :> "graph" :> Get '[JSON] (Maybe GraphInfo)
+    :<|> "goals" :> "render" :> Get '[PlainText] T.Text
     :<|> "goals" :> "uigoal" :> Get '[JSON] GoalTracking
     :<|> "goals" :> Get '[JSON] WinCondition
     :<|> "navigation" :> Get '[JSON] (Navigation (M.Map SubworldName) Location)
@@ -164,6 +166,7 @@ mkApp state events =
     :<|> prereqsHandler state
     :<|> activeGoalsHandler state
     :<|> goalsGraphHandler state
+    :<|> goalsRenderHandler state
     :<|> uiGoalHandler state
     :<|> goalsHandler state
     :<|> navigationHandler state
@@ -206,6 +209,13 @@ goalsGraphHandler appStateRef = do
     WinConditions _winState oc -> Just $ makeGraphInfo oc
     _ -> Nothing
 
+goalsRenderHandler :: IO AppState -> Handler T.Text
+goalsRenderHandler appStateRef = do
+  appState <- liftIO appStateRef
+  return $ case appState ^. gameState . winCondition of
+    WinConditions _winState oc -> T.pack $ renderGoalsGraph oc
+    _ -> mempty
+
 uiGoalHandler :: IO AppState -> Handler GoalTracking
 uiGoalHandler appStateRef = do
   appState <- liftIO appStateRef
diff --git a/src/swarm-web/Swarm/Web/GraphRender.hs b/src/swarm-web/Swarm/Web/GraphRender.hs
new file mode 100644
index 000000000..7b7211e55
--- /dev/null
+++ b/src/swarm-web/Swarm/Web/GraphRender.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Web.GraphRender where
+
+import Control.Lens ((^.), (^..))
+import Data.Map qualified as M
+import Data.Maybe (fromMaybe)
+import Data.Text qualified as T
+import Swarm.Game.Scenario.Objective
+import Swarm.Game.Scenario.Objective.Graph
+import Text.Dot
+
+renderGoalsGraph :: ObjectiveCompletion -> String
+renderGoalsGraph oc =
+  showDot nlg
+ where
+  edgeLookup = M.fromList $ map (\x@(_, b, _) -> (b, x)) edges
+  nlg =
+    netlistGraph
+      (\k -> maybe mempty (\(a, _, _) -> [("label", T.unpack $ fromMaybe "<?>" $ a ^. objectiveId)]) $ M.lookup k edgeLookup)
+      (\k -> maybe mempty (\(_, _, c) -> c) $ M.lookup k edgeLookup)
+      ([(a, a) | (_, a, _) <- edges])
+
+  edges = makeGraphEdges objs
+  objs = oc ^.. allObjectives
diff --git a/swarm.cabal b/swarm.cabal
index a83dff2f6..ba012a7d9 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -774,12 +774,14 @@ library swarm-web
     wai,
     wai-app-static,
     warp,
+    dotgen,
     witch,
 
   visibility: public
   -- cabal-gild: discover src/swarm-web
   exposed-modules:
     Swarm.Web
+    Swarm.Web.GraphRender
     Swarm.Web.Worldview
 
   other-modules: Paths_swarm