Simple.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Running Lorentz code easily.
--
-- For testing and demonstration purposes.
module Lorentz.Run.Simple
  ( (-$?)
  , (-$)
  , (&?-)
  , (&-)
  , (<-$>)
  , ZippedStackRepr(..)
  , ZSNil(..)
  ) where

import Lorentz.Base
import Lorentz.Run
import Lorentz.Value
import Lorentz.Zip
import Morley.Michelson.Interpret
import Morley.Michelson.Runtime.Dummy (dummyContractEnv)

{- Note about priority:

We want priority of our operators to be higher than of operators from HUnit
(which is 1), but less than priority of the most our other operators like '#'.
-}

-- $setup
-- >>> :m +Lorentz.Base Lorentz.Instr

----------------------------------------------------------------------------
-- Common case
----------------------------------------------------------------------------

-- | Run a lambda with given input.
--
-- Note that this always returns one value, but can accept multiple
-- input values (in such case they are grouped into nested pairs).
--
-- For testing and demonstration purposes.
infixr 2 -$?
(-$?) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out)
      => (inps :-> '[out]) -> ZippedStack inps -> Either MichelsonFailureWithStack out
code -$? inp = interpretLorentzLambda dummyContractEnv (unzipInstr # code) inp

-- | Like @'-$?'@, assumes that no failure is possible.
--
-- For testing and demonstration purposes. Note, that we specify the result type of polymorphic
-- operations to avoid ambiguity arising from polymorphic literals.
--
-- Use 'ZippedStackRepr' to represent stack of two or more elements, and 'ZSNil' for empty stacks.
-- Stacks of one element are represented by the element itself.
--
-- >>> nop -$ 5
-- 5
-- >>> sub -$ 3 ::: 2 :: Integer
-- 1
-- >>> push 9 -$ ZSNil
-- 9
-- >>> add # add -$ 1 ::: 2 ::: 3 :: Integer
-- 6
infixr 2 -$
(-$) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack)
     => inps :-> '[out] -> ZippedStack inps -> out
code -$ inp = unsafe $ code -$? inp

----------------------------------------------------------------------------
-- Flipped versions
----------------------------------------------------------------------------

-- | Version of (-$?) with arguments flipped.
infixl 2 &?-
(&?-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out)
      => ZippedStack inps -> (inps :-> '[out]) -> Either MichelsonFailureWithStack out
(&?-) = flip (-$?)

-- | Version of (-$) with arguments flipped.
infixl 2 &-
(&-) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack)
     => ZippedStack inps -> (inps :-> '[out]) -> out
(&-) = flip (-$)

----------------------------------------------------------------------------
-- Experimental versions
----------------------------------------------------------------------------

-- | Version of (-$) applicable to a series of values.
infixl 2 <-$>
(<-$>) :: (ZipInstr inps, IsoValue (ZippedStack inps), IsoValue out, HasCallStack)
       => (inps :-> '[out]) -> [ZippedStack inps] -> [out]
code <-$> inps = map (code -$) inps