render goals graph

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

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

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

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