Error.hs

-- | Misuse that must be fatal rather than silently wrong.
module Spec.Error (tests) where

import Control.Monad (void)
import Data.Coerce (coerce)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Fragr (Handle (..))
import Fragr qualified as FG
import Utils

tests :: TestTree
tests =
  testGroup
    "error model"
    [ staleRead
    , staleWrite
    , readOwnCreate
    , readOwnWrite
    , wrongResourceType
    , undeclaredGet
    , outOfRangeHandle
    , executeBeforeCompile
    ]

staleRead :: TestTree
staleRead = testCase "reading a stale handle is fatal" do
  g <- FG.newFrameGraph @Env @Env
  h1 <- FG.importResource g "BB" (tex "BB") (Tex 1)
  FG.addPass_ g "P" (FG.write_ h1) (pure ())
  assertFatal $ FG.addPass_ g "Q" (FG.read h1) (pure ())

staleWrite :: TestTree
staleWrite = testCase "writing a stale handle is fatal" do
  g <- FG.newFrameGraph @Env @Env
  h1 <- FG.importResource g "BB" (tex "BB") (Tex 1)
  FG.addPass_ g "P" (FG.write_ h1) (pure ())
  assertFatal $ FG.addPass_ g "Q" (FG.write_ h1) (pure ())

readOwnCreate :: TestTree
readOwnCreate = testCase "reading a handle the pass created is fatal" do
  g <- FG.newFrameGraph @Env @Env
  assertFatal $
    FG.addPass
      g
      "P"
      ( do
          h <- FG.create @Tex "R" (tex "R")
          FG.read h
      )
      \_data -> pure ()

readOwnWrite :: TestTree
readOwnWrite = testCase "reading a handle the pass wrote is fatal" do
  g <- FG.newFrameGraph @Env @Env
  h1 <- FG.importResource g "BB" (tex "BB") (Tex 1)
  assertFatal $
    FG.addPass
      g
      "P"
      ( do
          h2 <- FG.write h1
          FG.read h2
      )
      \_data -> pure ()

wrongResourceType :: TestTree
wrongResourceType = testCase "get with the wrong resource type is fatal" do
  g <- FG.newFrameGraph @Env @Env
  env <- newEnv
  _ <-
    FG.addPass
      g
      "P"
      ( do
          h <- FG.create @Tex "R" (tex "R")
          FG.write_ h
          FG.setSideEffect
          pure h
      )
      -- Honest handles carry their resource type; forging a
      -- wrongly-typed one takes a 'coerce'. The runtime guard
      -- still catches it.
      \h -> void (FG.get @Buf (coerce h))
  FG.compile g
  assertFatal $ FG.execute g env env

undeclaredGet :: TestTree
undeclaredGet = testCase "get on an undeclared handle is fatal" do
  g <- FG.newFrameGraph @Env @Env
  env <- newEnv
  h <-
    FG.addPass
      g
      "P"
      ( do
          h <- FG.create @Tex "R" (tex "R")
          FG.write_ h
          FG.setSideEffect
          pure h
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Q"
      ( do
          FG.read h
          FG.setSideEffect
      )
      \_data ->
        -- Q reads h, but this forged handle was never declared.
        void (FG.get @Tex (Handle 99))
  FG.compile g
  assertFatal $ FG.execute g env env

outOfRangeHandle :: TestTree
outOfRangeHandle = testCase "out-of-range handles are fatal, not merely invalid" do
  g <- FG.newFrameGraph @Env @Env
  assertFatal $ FG.isValid g (Handle 99)

executeBeforeCompile :: TestTree
executeBeforeCompile = testCase "execute before compile is fatal" do
  g <- FG.newFrameGraph @Env @Env
  env <- newEnv
  assertFatal $ FG.execute g env env