MismatchError.hs

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

module TestSuite.Cleveland.MismatchError
  ( unit_UnexpectedStorageType
  , unit_UnexpectedTLT
  , unit_UnexpectedStorageTypeSimple
  , unit_UnexpectedTLTSimple
  , unit_StackEqErrorSimple
  , unit_StackEqError
  ) where

import Fmt (pretty, prettyText)
import Test.Tasty.HUnit (Assertion, (@?=))

import Morley.Michelson.TypeCheck.Error
import Morley.Michelson.Typed qualified as T
import Morley.Util.Interpolate
import Morley.Util.MismatchError

import Test.Cleveland.Internal.Pure

unit_UnexpectedStorageTypeSimple :: Assertion
unit_UnexpectedStorageTypeSimple = do
  pretty (
    UnexpectedStorageType MkMismatchError
      { meExpected = T.TInt, meActual = T.TUnit })
    @?= expectedSimple

unit_UnexpectedTLTSimple :: Assertion
unit_UnexpectedTLTSimple = do
  pretty (
    UnexpectedTopLevelType TltStorageType
      MkMismatchError { meExpected = T.TInt, meActual = T.TUnit })
    @?= expectedSimple

unit_StackEqErrorSimple :: Assertion
unit_StackEqErrorSimple = do
  prettyText (
    StackEqError
      MkMismatchError { meExpected = [T.TInt], meActual = [T.TUnit] })
    @?= [itu|
      Stacks not equal:
        Expected: [int]
        Actual:   [unit]
      |]

unit_UnexpectedStorageType :: Assertion
unit_UnexpectedStorageType = do
  pretty (
    UnexpectedStorageType MkMismatchError
      { meExpected = T.TInt, meActual = T.TPair T.TUnit (T.TPair T.TNat T.TBytes) })
    @?= expected

unit_UnexpectedTLT :: Assertion
unit_UnexpectedTLT = do
  pretty (
    UnexpectedTopLevelType TltStorageType
      MkMismatchError { meExpected = T.TInt, meActual = T.TPair T.TUnit (T.TPair T.TNat T.TBytes) })
    @?= expected

unit_StackEqError :: Assertion
unit_StackEqError = do
  prettyText (
    StackEqError
      MkMismatchError
        { meExpected =
          [ T.TPair T.TInt (T.TPair T.TNat T.TBytes)
          , T.TPair T.TNat (T.TPair T.TUnit T.TBool)]
        , meActual =
          [ T.TPair T.TUnit (T.TPair T.TNat T.TBytes)
          , T.TPair T.TNat (T.TPair T.TInt T.TBool)
          , T.TPair T.TNat T.TNat
          ]})
    @?= [itu|
      Stacks not equal:
        Expected: [pair int nat bytes, pair nat unit bool]
        Actual:   [pair unit nat bytes, pair nat int bool, pair nat nat]
        Mismatch:
          --- expected +++ actual
        - [ pair int nat bytes
        - , pair nat unit bool
        + [ pair unit nat bytes
        + , pair nat int bool
        + , pair nat nat
          ]
      |]

expectedSimple :: Text
expectedSimple = [itu|
  Unexpected storage type:
    Expected: int
    Actual:   unit
  |]

expected :: Text
expected = [itu|
  Unexpected storage type:
    Expected: int
    Actual:   pair unit nat bytes
  |]