packages feed

cleveland-0.3.1: test/TestSuite/Cleveland/PrettyFailWith.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module TestSuite.Cleveland.PrettyFailWith
  ( test_PrettyFailWith
  ) where

import Lorentz (Contract, car, defaultContract, failWith, nil, pair, sender, (#))

import Fmt (fmt, (+|), (|+))
import Test.Tasty (TestTree)

import Test.Cleveland
import TestSuite.Util

test_PrettyFailWith :: TestTree
test_PrettyFailWith = testScenarioOnEmulator "FailWith shows its argument using human-readable representation" $ scenarioEmulated do
  addr <- newFreshAddress auto
  transfer addr [tz|1u|] -- need at least some money to call
  withSender addr do
    cont <- originate "failing" () failing
    transfer cont &
      shouldFailWithMessage (fmt $ "failed with: \"" +| toAddress addr |+ "\"")

failing :: Contract () () ()
failing = defaultContract $ car # sender # failWith # nil # pair