Dot.hs

-- | Graphviz rendering of the graph and of its schedule.
module Spec.Dot (tests) where

import Control.Monad (void)
import Data.Text qualified as Text
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, testCase)

import Fragr (QueueId (..))
import Fragr qualified as FG
import Fragr.Snapshot.Dot qualified as Dot
import Utils

tests :: TestTree
tests =
  testGroup
    "dot output"
    [ rendersPassesAndVersions
    , clusteredImports
    , groupedImports
    , stratifiedRanks
    , antiEdges
    , syncView
    ]

rendersPassesAndVersions :: TestTree
rendersPassesAndVersions = testCase "renders passes, resources and versions" do
  g <- FG.newFrameGraph @Env @Env
  backbuffer <- FG.importResource g "backbuffer" (tex "backbuffer") (Tex 1)
  hA <-
    FG.addPass
      g
      "Draw"
      ( do
          h <- FG.create @Tex "color" (tex "color")
          FG.write h
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Present"
      ( do
          FG.read hA
          FG.write backbuffer
      )
      \_data -> pure ()
  FG.addPass_ g "Culled" (pure ()) (pure ())
  FG.compile g
  out <- Dot.dump g
  has out "digraph FrameGraph {"
  has out "P0"
  has out "Draw"
  has out "R0_2" -- renamed backbuffer
  has out "backbuffer v2"
  has out "fillcolor=lightgray" -- the culled pass
  has out "fillcolor=lightsteelblue" -- the initial import version
  has out "fillcolor=steelblue" -- its written successor
  assertBool "imports float by default" (not ("cluster_imported" `Text.isInfixOf` out))

clusteredImports :: TestTree
clusteredImports = testCase "opting in fences the imports in a cluster" do
  g <- FG.newFrameGraph @Env @Env
  backbuffer <- FG.importResource g "backbuffer" (tex "backbuffer") (Tex 1)
  FG.addPass_ g "Present" (void (FG.write backbuffer)) (pure ())
  FG.compile g
  out <- Dot.dumpWith Dot.defaultOptions{Dot.clusterImports = True} g
  has out "cluster_imported"
  has out "label=\"Imported\""

groupedImports :: TestTree
groupedImports = testCase "imports sharing a dotted prefix group into one record node" do
  g <- FG.newFrameGraph @Env @Env
  m0 <- FG.importResource g "img.mip0" (tex "img.mip0") (Tex 0)
  m1 <- FG.importResource g "img.mip1" (tex "img.mip1") (Tex 1)
  solo <- FG.importResource g "shadow" (tex "shadow") (Tex 2)
  FG.addPass_
    g
    "Read"
    do
      FG.read m0
      FG.read m1
      FG.read solo
      FG.setSideEffect
    (pure ())
  FG.compile g
  out <- Dot.dump g
  -- One family vertex with a port per member, edges through the ports.
  has out "G0 [label=\"{img|{<n0> mip0|<n1> mip1}}\""
  has out "G0:n0 -> { P0 }"
  has out "G0:n1 -> { P0 }"
  -- The undotted import keeps its own vertex; the members lose theirs.
  has out "R2_1 [label=\"{shadow"
  assertBool "no standalone mip0 vertex" (not ("R0_1 [" `Text.isInfixOf` out))
  assertBool "no standalone mip1 vertex" (not ("R1_1 [" `Text.isInfixOf` out))

stratifiedRanks :: TestTree
stratifiedRanks = testCase "stratifying ranks the passes by dependency level" do
  g <- FG.newFrameGraph @Env @Env
  -- Two independent producers (level 0), one consumer of both (level 1).
  hA <- FG.addPass g "GenA" (FG.create @Tex "a" (tex "a") >>= FG.write) \_d -> pure ()
  hB <- FG.addPass g "GenB" (FG.create @Tex "b" (tex "b") >>= FG.write) \_d -> pure ()
  FG.addPass_ g "Combine" (FG.read hA >> FG.read hB >> FG.setSideEffect) (pure ())
  FG.addPass_ g "Culled" (pure ()) (pure ())
  FG.compile g
  out <- Dot.dumpWith Dot.defaultOptions{Dot.stratify = True} g
  has out "{ rank=same; P0 P1 }"
  has out "{ rank=same; P2 }"
  assertBool "the culled pass is unpinned" (not ("P3 }" `Text.isInfixOf` out))
  off <- Dot.dump g
  assertBool "ranks are off by default" (not ("rank=same" `Text.isInfixOf` off))

antiEdges :: TestTree
antiEdges = testCase "anti-edges overlay the reader a later write supersedes" do
  g <- FG.newFrameGraph @Env @Env
  backbuffer <- FG.importResource g "backbuffer" (tex "backbuffer") (Tex 1)
  FG.addPass_ g "Sample" (FG.read backbuffer >> FG.setSideEffect) (pure ())
  FG.addPass_ g "Overwrite" (FG.write_ backbuffer >> FG.setSideEffect) (pure ())
  FG.compile g
  out <- Dot.dump g
  -- Sample reads v1, Overwrite renames it to v2: no dataflow, but an order.
  assertBool "reader -> renamer edge" ("P0 -> P1 [style=dashed" `Text.isInfixOf` out)
  off <- Dot.dumpWith Dot.defaultOptions{Dot.antiEdges = False} g
  assertBool "anti-edges can be turned off" (not ("dashed" `Text.isInfixOf` off))

syncView :: TestTree
syncView = testCase "the sync view renders queue lanes, waits, transfers and retires" do
  g <- FG.newFrameGraph @Device @Device
  gbuf <-
    FG.addPass
      g
      "Graphics"
      (FG.create @Image "gbuf" (img "gbuf") >>= (`FG.writeWith` ColorAttachment))
      \_data -> pure ()
  lit <-
    FG.addPass
      g
      "Compute"
      ( do
          FG.setQueue (QueueId 1)
          FG.readWith gbuf ShaderRead
          FG.create @Image "lit" (img "lit") >>= (`FG.writeWith` General)
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Present"
      (FG.readWith lit ShaderRead >> FG.setSideEffect)
      \_data -> pure ()
  FG.addPass_ g "Culled" (pure ()) (pure ())
  FG.compile g
  out <- Dot.dumpSync g
  has out "digraph FrameGraphSync {"
  -- One lane per queue, chained in submission order.
  has out "cluster_q0"
  has out "label=\"queue 1\""
  has out "P0 [label=\"{Graphics|signal 1}\""
  has out "P0 -> P2 [color=gray"
  -- The cross-queue wait edge, scoped by its covers.
  has out "P0 -> P1 [label=\">=1\\ngbuf @ShaderRead\", color=royalblue]"
  -- Release / acquire pairs render as transfer edges.
  has out "P0 -> P1 [label=\"gbuf @ShaderRead\", color=purple]"
  has out "P1 -> P2 [label=\"lit @ShaderRead\", color=purple]"
  -- Retire notes hang off the last toucher.
  has out "T0 [shape=note, label=\"retire gbuf\\nq0>=1, q1>=1\", fillcolor=khaki]"
  has out "P1 -> T0"
  assertBool "culled passes are absent" (not ("Culled" `Text.isInfixOf` out))