Print.hs

{-# LANGUAGE DeriveAnyClass #-}

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

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

import Lorentz hiding (contract, unpack)
import Michelson.Printer.Util (buildRenderDoc)
import Michelson.Typed hiding (Contract)
import Michelson.Untyped (para)

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 = drop # unit # nil # pair

test_Print_parameter_annotations :: [TestTree]
test_Print_parameter_annotations =
  [ testCase "Simple parameter" $
      let typedContract = compileLorentzContract contract
          untypedContract = convertFullContract typedContract
      in buildRenderDoc (para 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 } }"
  ]