Print.hs

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

-- | Tests for the @PRINT@ extended command

module Test.Interpreter.Print
  ( test_print_simple
  , test_print_operations
  ) where

import Data.Default (Default(def))
import Fmt ((+|), (|+))
import Test.Tasty (TestTree)

import Morley.Michelson.Interpret (MorleyLogs(..))
import Morley.Michelson.Text (MText)
import qualified Morley.Michelson.Typed as T
import Morley.Michelson.Typed.Instr
import Morley.Tezos.Address (Address)
import Test.Cleveland

test_print_simple :: [TestTree]
test_print_simple =
  [ testScenarioOnEmulator "PRINT prints naturals" $ scenarioEmulated do
      printer <- originateTypedSimple @Natural @_ @() "printer" () printerContract
      logsInfo <- getMorleyLogs_ $
        call printer CallDefault (123 :: Natural)
      collectLogs logsInfo @== MorleyLogs ["123"]
  , testScenarioOnEmulator "PRINT prints strings" $ scenarioEmulated do
      printer <- originateTypedSimple @MText @_ @() "printer" () printerContract
      logsInfo <- getMorleyLogs_ $
        call printer CallDefault "hello"
      collectLogs logsInfo @== MorleyLogs ["\"hello\""]
  , testScenarioOnEmulator "PRINT prints right combs" $ scenarioEmulated do
      printer <- originateTypedSimple @(Integer, (Integer, Integer)) @_ @() "printer" () printerContract
      logsInfo <- getMorleyLogs_ $
        call printer CallDefault (1, (2, 3))
      collectLogs logsInfo @== MorleyLogs ["{ 1; 2; 3 }"]
  , testScenarioOnEmulator "PRINT prints sequences" $ scenarioEmulated do
      printer <- originateTypedSimple @[Integer] @_ @() "printer" () printerContract
      logsInfo <- getMorleyLogs_ $
        call printer CallDefault [1..5]
      collectLogs logsInfo @== MorleyLogs ["{ 1; 2; 3; 4; 5 }"]
  ]

test_print_operations :: TestTree
test_print_operations =
    testScenarioOnEmulator "PRINT prints operations" $ scenarioEmulated do
      addr <- newFreshAddress auto
      printer <- originateTypedSimple @Address @_ @() "printerOps" () operationPrinter
      logsInfo <- getMorleyLogs_ $
        call printer CallDefault addr
      collectLogs logsInfo @==
        MorleyLogs ["{ Transfer 123 μꜩ tokens to Contract " +| addr |+ " call Call <default>: × }"]

operationPrinter :: T.Contract 'T.TAddress 'T.TUnit
operationPrinter = T.Contract{..}
  where
    cParamNotes = T.starParamNotes
    cStoreNotes = T.starNotes

    cEntriesOrder = def

    stackRef = PrintComment . one . Right $ mkStackRef @0

    cViews = def
    cCode :: Instr '[ 'T.TPair 'T.TAddress 'T.TUnit ] '[ 'T.TPair ('T.TList 'T.TOperation) 'T.TUnit ]
    cCode =
      UNPAIR `Seq`
      CONTRACT T.starNotes T.DefEpName `Seq`
      IF_NONE (PUSH (T.VString "No contract") `Seq` FAILWITH) (
        PUSH (T.VMutez 123) `Seq`
        PUSH T.VUnit `Seq`
        TRANSFER_TOKENS `Seq`
        DIP NIL `Seq`
        CONS `Seq`
        Ext (PRINT stackRef) `Seq`
        DROP `Seq`
        NIL `Seq`
        PAIR
      )

printerContract :: (T.ContainsNestedBigMaps p ~ 'False, T.ConstantScope p) => T.Contract p (T.ToT ())
printerContract = T.Contract{..}
  where
    cParamNotes = T.starParamNotes
    cStoreNotes = T.starNotes

    cEntriesOrder = def

    stackRef = PrintComment . one . Right $ mkStackRef @0

    cViews = def
    cCode =
      UNPAIR `Seq`
      Ext (PRINT stackRef) `Seq`
      DROP `Seq`
      NIL `Seq`
      PAIR