packages feed

cleveland-0.2.0: 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
  transferMoney addr 1 -- need at least some money to call
  withSender addr do
    cont <- originateSimple "failing" () failing
    call cont CallDefault () &
      shouldFailWithMessage (fmt $ "failed with: \"" +| addr |+ "\"")

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