Examples.hs

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

-- | Examples of Indigo Contracts and Tests for them

module Test.Code.Examples
  ( DummyOp (..)
  , contractVarLorentz
  , ifTest
  , contractIfLorentz
  , contractIfValueLorentz
  , contractWhileLorentz
  , contractForEachLorentz
  , contractCaseLorentz
  , contractDocLorentz
  , contractOpsLorentz
  , contractAssertLorentz
  , contractUserCommentLorentz
  , contractIfRightLorentz
  , contractIfConsLorentz
  , contractWhileLeftLorentz
  , contractWhileLeftIndigo
  ) where

import Indigo
import qualified Lorentz.Run as L
import Michelson.Doc (DName(..))
import Test.Util

contractVarLorentz :: ContractCode Integer Integer
contractVarLorentz = compileIndigoContract $ \_param ->
  when (5 int < 10 int) do
    _a <- new$ 10 int
    return ()

ifTest :: L.Contract Integer Integer
ifTest = noOptimizationContract contractIfValueLorentz

contractIfLorentz :: ContractCode Integer Integer
contractIfLorentz = L.cCode ifTest

contractIfValueLorentz :: ContractCode Integer Integer
contractIfValueLorentz = compileIndigoContract $ \param -> do
  a <- new$ 7 int + param
  when (param < a) do
    _c <- new$ storageVar @Integer
    return ()
  _c <- new$ param < storageVar @Integer
  return ()

contractWhileLorentz :: ContractCode Integer Integer
contractWhileLorentz = compileIndigoContract $ \param -> do
  i <- new$ 0 int
  s <- new$ 0 int
  while (i < storageVar @Integer) do
    when (i % param == 0 nat) $
      s += i
    i += 1 int
  storageVar =: s

contractForEachLorentz :: ContractCode [Integer] Integer
contractForEachLorentz = compileIndigoContract $ \param -> do
  s <- new$ 0 int
  forEach param $ \it -> do
    s =: s + it
  storageVar =: s

contractCaseLorentz :: ContractCode DummyOp Integer
contractCaseLorentz = compileIndigoContract $ \param -> scope do
  -- This example demonstrates the following:
  -- 1. types of the stack case branched may be diverged,
  --    they are automatically moved to the same stack
  -- 2. branches can return not exactly the same types
  ---   it's useful when you have case bodies in-place, like
  --      case_ param $
  --        ( #cSomething1 #= const $ return (5 int)
  --        , #cSomething2 #= (\var -> return (10 +. var))
  --        , #cSomething3 #= return var)
  -- Pay attention, that all three branches have different return types
  -- but they all correspond to the same expression 'Expr Integer'.
  _flag <- case_ param $
          ( #cDSub #= doSub storageVar
          , #cDAdd #= doAdd storageVar
          )
  return ()

data DummyOp
  = DSub (Integer, Integer)
  | DAdd (Integer, Integer)
  deriving stock (Generic, Show)
  deriving anyclass (IsoValue)

instance ParameterHasEntrypoints DummyOp where
  type ParameterEntrypointsDerivation DummyOp = EpdPlain

doSub :: Var Integer -> Var (Integer, Integer) -> IndigoM (Var Bool)
doSub storage p = do
  -- Create a variable to demostrate that branches of case
  -- are cleaned automatically
  testVar <- new$ True
  storage =: fst p - snd p
  return testVar

doAdd :: Var Integer -> Var (Integer, Integer) -> IndigoM Bool
doAdd storage p = do
  storage =: fst p + snd p
  return False

contractDocLorentz :: ContractCode Integer Integer
contractDocLorentz = compileIndigoContract $ \param -> do
  doc (DDescription "x")
  contractName "aaa" (doc $ DDescription "a")
  i <- new$ 10 int
  docGroup (SomeDocItem . DName "bbb") (doc $ DDescription "b")
  storageVar =: param + i

contractOpsLorentz :: ContractCode (Maybe KeyHash) Address
contractOpsLorentz = compileIndigoContract $ \param -> do
  setDelegate param
  m <- new$ zeroMutez
  is <- new$ 0 int
  addr <- createLorentzContract ifTest param m is
  storageVar =: addr

contractAssertLorentz :: ContractCode Integer Integer
contractAssertLorentz = compileIndigoContract $ \param -> do
  s <- new$ param + storageVar @Integer
  z <- new$ 0 int
  assert negativeResM (s > z)
  storageVar =: s

contractUserCommentLorentz :: ContractCode Integer Integer
contractUserCommentLorentz = compileIndigoContract $ \param -> do
  s <- commentAroundStmt "param plus storage" $ new$ param + storageVar @Integer
  _z <- new$ 0 int
  justComment "just comment"
  storageVar =: s

contractIfRightLorentz :: ContractCode Integer Integer
contractIfRightLorentz = compileIndigoContract $ \param -> do
  a <- new$ left $ 0 int
  if_ (param >= 10 int)
    (a =: right param)
    (a =: left param)

  ifLeft a
    (\_l -> do
      storageVar =: 0 int
    )
    (\_r -> do
      storageVar =: 10 int
    )

contractIfConsLorentz :: ContractCode Integer Integer
contractIfConsLorentz = compileIndigoContract $ \param -> do
  a <- new$ ([] :: List Integer)
  if_ (param >= 10 int)
    (a =: 3 int .: 2 int .: [])
    (a =: [])

  ifCons a
    (\x _xs ->
      storageVar =: x
    )
    (storageVar =: 0 int)

contractWhileLeftLorentz :: ContractCode Integer Integer
contractWhileLeftLorentz = compileIndigoContract contractWhileLeftIndigo

-- This contract is used for a demonstration of automatic commenting capabilities
contractWhileLeftIndigo :: HasStorage Integer => Var Integer -> IndigoM ()
contractWhileLeftIndigo param = do
  iL <- new$ left $ param
  s <- whileLeft iL $ whileBody iL
  storageVar =: s
  where
    whileBody :: HasCallStack => Var (Either Integer Integer) -> Var Integer -> IndigoM ()
    whileBody iL i =
      if_ (i >= 10 int)
        (iL =: right i)
        (do
          if_ (i % 2 int == 0 nat)
            (iL =: left $ i + 2 int)
            (iL =: right i)
        )