Macro.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Tests for Lorentz macros.
--
-- They test logic of macros and type-level logic.  Also they serve as
-- examples of using complex macros (e. g. parameterized with
-- type-level numbers)

module Test.Lorentz.Macro
  ( unit_duupX
  , unit_replaceN
  , unit_updateN
  , test_execute
  ) where

import Prelude hiding (drop, swap)
import Test.HUnit (Assertion, (@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Lorentz

import Michelson.Test.Dummy

unit_duupX :: Assertion
unit_duupX = do
  duupX @1 @?= dup
  duupX @2 @?= (dip dup # swap)
  duupX @3 @?= duupX3
  where
    duupX3 :: [Bool, Integer, (), Bool] :-> [(), Bool, Integer, (), Bool]
    duupX3 = dipN @2 dup # dig @2

unit_replaceN :: Assertion
unit_replaceN = do
  replaceN @1 @?= swap # drop
  replaceN @2 @?= replaceN2
  replaceN @3 @?= replaceN3
  where
    replaceN2 :: [(), Integer, (), Bool] :-> [Integer, (), Bool]
    replaceN2 = dipN @2 drop # dug @1

    replaceN3 :: [Bool, Integer, (), Bool] :-> [Integer, (), Bool]
    replaceN3 = dipN @3 drop # dug @2

unit_updateN :: Assertion
unit_updateN = do
  updateN @1 cons @?= updateN1
  updateN @2 cons @?= updateN2
  updateN @3 cons @?= updateN3
  where
    updateN1 :: [Bool, [Bool], Integer, ()] :-> [[Bool], Integer, ()]
    updateN1 = cons

    updateN2 :: [Bool, Integer, [Bool], ()] :-> [Integer, [Bool], ()]
    updateN2 = swap # dip cons

    updateN3 :: [Bool, Integer, (), [Bool]] :-> [Integer, (), [Bool]]
    updateN3 = dug @2 # dipN @2 cons

test_execute :: [TestTree]
test_execute =
  [ testCase "Two arguments lambda" $
      let lam :: [Integer, Integer] :-> [(), Integer]
          lam = add # unit
          code = push 3 # push lam # execute # drop @()
      in interpretLorentzLambda dummyContractEnv code 5
          @?= Right 8

  , testCase "Zero arguments lambda" $
      let lam :: '[] :-> '[Integer]
          lam = push 5
          code = drop # push lam # execute
      in interpretLorentzLambda dummyContractEnv code (0 :: Integer)
          @?= Right 5
  ]