JSON.hs

-- | JSON rendering of the graph for the interactive viewer.
module Spec.JSON (tests) where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))

import Fragr qualified as FG
import Fragr.Snapshot.JSON (ViewerGraph (..), ViewerPass (..), ViewerResource (..))
import Fragr.Snapshot.JSON qualified as Json
import Utils

tests :: TestTree
tests =
  testGroup
    "json output"
    [ renderDocument
    , dumpsCompiledGraph
    ]

renderDocument :: TestTree
renderDocument = testCase "render emits the viewer document, omitting empty resource fields" do
  let graph =
        ViewerGraph
          { passes =
              [ ViewerPass{id = 0, name = "Draw", culled = False, reads = [], writes = [1]}
              , ViewerPass{id = 1, name = "Culled", culled = True, reads = [], writes = []}
              ]
          , resources =
              [ ViewerResource
                  { id = 0
                  , name = "backbuffer"
                  , description = "a \"quoted\"\ntitle"
                  , transient = False
                  , createdBy = Nothing
                  , readers = []
                  , writers = [1]
                  }
              , ViewerResource
                  { id = 1
                  , name = "color"
                  , description = ""
                  , transient = True
                  , createdBy = Just 0
                  , readers = [1]
                  , writers = [0]
                  }
              ]
          }
  Json.render graph
    @?= mconcat
      [ "{\"passes\":["
      , "{\"id\":0,\"name\":\"Draw\",\"culled\":false,\"reads\":[],\"writes\":[1]},"
      , "{\"id\":1,\"name\":\"Culled\",\"culled\":true,\"reads\":[],\"writes\":[]}"
      , "],\"resources\":["
      , "{\"id\":0,\"name\":\"backbuffer\",\"description\":\"a \\\"quoted\\\"\\u000atitle\",\"transient\":false,\"writers\":[1]},"
      , "{\"id\":1,\"name\":\"color\",\"description\":\"\",\"transient\":true,\"createdBy\":0,\"readers\":[1],\"writers\":[0]}"
      , "]}"
      ]

dumpsCompiledGraph :: TestTree
dumpsCompiledGraph = testCase "dump projects the compiled graph" 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 "Skipped" (pure ()) (pure ())
  FG.compile g
  out <- Json.dump g
  has out "{\"passes\":[{\"id\":0,\"name\":\"Draw\",\"culled\":false,\"reads\":[],\"writes\":[1]}"
  -- Writing the import is a read-modify-write: backbuffer shows in reads too.
  has out "{\"id\":1,\"name\":\"Present\",\"culled\":false,\"reads\":[1,0],\"writes\":[0]}"
  has out "{\"id\":2,\"name\":\"Skipped\",\"culled\":true"
  -- The transient carries its creator; the whole rename chain lands on one record.
  has out "\"name\":\"color\""
  has out "\"transient\":true,\"createdBy\":0,\"readers\":[1],\"writers\":[0]}"
  has out "\"name\":\"backbuffer\""
  has out "\"transient\":false,\"readers\":[1],\"writers\":[1]}"