-- 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 out)
      => (IsNotInView => inps :-> '[out]) -> ZippedStack inps -> Either MichelsonFailureWithStack out
IsNotInView => inps :-> '[out]
code -$? :: forall (inps :: [*]) out.
(ZipInstr inps, IsoValue out) =>
(IsNotInView => inps :-> '[out])
-> ZippedStack inps -> Either MichelsonFailureWithStack out
-$? ZippedStack inps
inp = ContractEnv
-> (IsNotInView => Fn (ZippedStack inps) out)
-> ZippedStack inps
-> Either MichelsonFailureWithStack out
forall inp out.
(IsoValue inp, IsoValue out) =>
ContractEnv
-> (IsNotInView => Fn inp out)
-> inp
-> Either MichelsonFailureWithStack out
interpretLorentzLambda ContractEnv
dummyContractEnv ('[ZippedStack inps] :-> inps
forall (s :: [*]). ZipInstr s => '[ZippedStack s] :-> s
unzipInstr ('[ZippedStack inps] :-> inps)
-> (inps :-> '[out]) -> Fn (ZippedStack inps) out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# inps :-> '[out]
IsNotInView => inps :-> '[out]
code) ZippedStack inps
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 out, HasCallStack)
     => (IsNotInView => inps :-> '[out]) -> ZippedStack inps -> out
IsNotInView => inps :-> '[out]
code -$ :: forall (inps :: [*]) out.
(ZipInstr inps, IsoValue out, HasCallStack) =>
(IsNotInView => inps :-> '[out]) -> ZippedStack inps -> out
-$ ZippedStack inps
inp = Either MichelsonFailureWithStack out -> out
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either MichelsonFailureWithStack out -> out)
-> Either MichelsonFailureWithStack out -> out
forall a b. (a -> b) -> a -> b
$ IsNotInView => inps :-> '[out]
code (IsNotInView => inps :-> '[out])
-> ZippedStack inps -> Either MichelsonFailureWithStack out
forall (inps :: [*]) out.
(ZipInstr inps, IsoValue out) =>
(IsNotInView => inps :-> '[out])
-> ZippedStack inps -> Either MichelsonFailureWithStack out
-$? ZippedStack inps
inp

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

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

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

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

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