Print.hs

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

{-# LANGUAGE DeriveAnyClass #-}

-- | Tests on Lorentz contracts pretty-printing.
module Test.Lorentz.Print
  ( test_Print_parameter_annotations
  , test_Print_lambda
  , unit_Erase_annotations
  ) where

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

import Lorentz hiding (contract, unpack)
import qualified Lorentz as L
import Michelson.Printer.Util (buildRenderDoc)
import Michelson.Typed hiding (Contract, ContractCode)
import Michelson.Untyped (contractParameter)

data MyEntryPoints1
  = Do1 Integer
  | Do2 (Integer, Integer)
  | Do3
  deriving stock Generic
  deriving anyclass IsoValue

instance ParameterHasEntryPoints MyEntryPoints1 where
  type ParameterEntryPointsDerivation MyEntryPoints1 = EpdPlain

contract :: Contract MyEntryPoints1 ()
contract = defaultContract $
  drop # unit # nil # pair

test_Print_parameter_annotations :: [TestTree]
test_Print_parameter_annotations =
  [ testCase "Simple parameter" $
      let typedContract = compileLorentzContract contract
          untypedContract = convertContract typedContract
      in buildRenderDoc (contractParameter untypedContract)
         @?=
         "or (int %do1) (or (pair %do2 int int) (unit %do3))"
  ]

test_Print_lambda :: [TestTree]
test_Print_lambda =
  [ testCase "Prints correct lambda instruction" $
      let
        code :: '[Integer] :-> '[('[Integer] :-> '[()])]
        code = drop # lambda (drop # unit)
     in printLorentzValue True code
        @?=
        "{ DROP; LAMBDA  int  unit  { DROP;UNIT } }"
  ]

data TestParam
  = TestCon1 ("a" :! Natural, "b" :! Bool)
  | TestCon2 ()
  deriving stock Generic
  deriving anyclass IsoValue

instance ParameterHasEntryPoints TestParam where
  type ParameterEntryPointsDerivation TestParam = EpdRecursive

unit_Erase_annotations :: Assertion
unit_Erase_annotations =
  let
    myContract :: Contract TestParam ()
    myContract = defaultContract $
      cdr # nil # L.pair

    expected = "parameter (or (pair %testCon1 (nat :a) (bool :b)) (unit %testCon2));storage unit;code { CAST (pair (or (pair nat bool) unit) unit);CDR;NIL operation;PAIR };"
  in assertEqual
      "Printed Lorentz contract is supposed to have an instruction which erases\
      \all parameter annotations, but it does not match the expected output"
      expected (L.printLorentzContract True myContract)