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

-- | Standard library for Indigo.
--
-- As opposed to Expr and Language modules, this module contains quite
-- standard things that are not present in vanilla Michelson and are
-- not typically found in imperative high level languages.

module Indigo.Lib
  ( -- * Views and Voids
    view_
  , void_
  , project
  , projectVoid

  -- * Others
  , subGt0
  ) where

import Indigo.Compilation
import Indigo.Frontend
import Indigo.Internal.Expr
import Indigo.Lorentz
import Indigo.Prelude
import Indigo.Rebinded

----------------------------------------------------------------------------
-- Views and Voids
----------------------------------------------------------------------------

-- | Indigo version of the @view@ macro. It takes a function from view
-- argument to view result and a 'View' structure that typically comes
-- from a top-level @case@.
view_ ::
  forall arg r viewExpr exr.
  ( KnownValue arg
  , NiceParameter r
  , viewExpr :~> View arg r
  , exr :~> r
  , HasSideEffects
  )
  => (Expr arg -> IndigoM exr)
  -> viewExpr
  -> IndigoM ()
view_ :: (Expr arg -> IndigoM exr) -> viewExpr -> IndigoM ()
view_ f :: Expr arg -> IndigoM exr
f v :: viewExpr
v = do
  exr
r <- Expr arg -> IndigoM exr
f (viewExpr
v viewExpr -> Label "viewParam" -> Expr arg
forall dt (name :: Symbol) ftype exDt.
(HasField dt name ftype, exDt :~> dt) =>
exDt -> Label name -> Expr ftype
#! Label "viewParam"
forall a. IsLabel "viewParam" a => a
forall (x :: Symbol) a. IsLabel x a => a
#viewParam)
  exr -> Expr Mutez -> Expr (ContractRef r) -> IndigoM ()
forall exp p exm exc.
(IsExpr exp p, IsExpr exm Mutez, IsExpr exc (ContractRef p),
 NiceParameter p, HasSideEffects) =>
exp -> exm -> exc -> IndigoM ()
transferTokens exr
r Expr Mutez
amount (viewExpr
v viewExpr -> Label "viewCallbackTo" -> Expr (ContractRef r)
forall dt (name :: Symbol) ftype exDt.
(HasField dt name ftype, exDt :~> dt) =>
exDt -> Label name -> Expr ftype
#! Label "viewCallbackTo"
forall a. IsLabel "viewCallbackTo" a => a
forall (x :: Symbol) a. IsLabel x a => a
#viewCallbackTo)

-- | Flipped version of 'view_' that is present due to the common
-- appearance of @flip view parameter $ instr@ construction.
--
-- Semantically we "project" the given parameter inside the body
-- of the 'View' construction.
project ::
  forall arg r viewExpr exr.
  ( KnownValue arg
  , NiceParameter r
  , viewExpr :~> View arg r
  , exr :~> r
  , HasSideEffects
  )
  => viewExpr
  -> (Expr arg -> IndigoM exr)
  -> IndigoM ()
project :: viewExpr -> (Expr arg -> IndigoM exr) -> IndigoM ()
project = ((Expr arg -> IndigoM exr) -> viewExpr -> IndigoM ())
-> viewExpr -> (Expr arg -> IndigoM exr) -> IndigoM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Expr arg -> IndigoM exr) -> viewExpr -> IndigoM ()
forall arg r viewExpr exr.
(KnownValue arg, NiceParameter r, viewExpr :~> View arg r,
 exr :~> r, HasSideEffects) =>
(Expr arg -> IndigoM exr) -> viewExpr -> IndigoM ()
view_

-- | Indigo version of the @void@ macro.
void_
  :: forall a b voidExpr exb.
  ( KnownValue a
  , IsError (VoidResult b)
  , NiceConstant b
  , voidExpr :~> Void_ a b
  , exb :~> b
  )
  => (Expr a -> IndigoM exb)
  -> voidExpr
  -> IndigoM ()
void_ :: (Expr a -> IndigoM exb) -> voidExpr -> IndigoM ()
void_ f :: Expr a -> IndigoM exb
f v :: voidExpr
v = do
  DThrows -> IndigoM ()
forall di. DocItem di => di -> IndigoM ()
doc (Proxy (VoidResult b) -> DThrows
forall e. ErrorHasDoc e => Proxy e -> DThrows
DThrows (Proxy (VoidResult b)
forall k (t :: k). Proxy t
Proxy @(VoidResult b)))
  exb
r <- Expr a -> IndigoM exb
f (voidExpr
v voidExpr -> Label "voidParam" -> Expr a
forall dt (name :: Symbol) ftype exDt.
(HasField dt name ftype, exDt :~> dt) =>
exDt -> Label name -> Expr ftype
#! Label "voidParam"
forall a. IsLabel "voidParam" a => a
forall (x :: Symbol) a. IsLabel x a => a
#voidParam)
  Expr (MText, b) -> IndigoM ()
forall r a ex. IsExpr ex a => ex -> IndigoM r
failWith (Expr (MText, b) -> IndigoM ()) -> Expr (MText, b) -> IndigoM ()
forall a b. (a -> b) -> a -> b
$ MText -> Expr b -> Expr (MText, b)
forall ex1 n ex2 m.
(ex1 :~> n, ex2 :~> m, KnownValue (n, m)) =>
ex1 -> ex2 -> Expr (n, m)
pair MText
voidResultTag (Expr b -> Expr (Lambda b b) -> Expr b
forall b a. KnownValue b => Expr a -> Expr (Lambda a b) -> Expr b
Exec (exb -> Expr (ExprType exb)
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr exb
r) (voidExpr
v voidExpr -> Label "voidResProxy" -> Expr (Lambda b b)
forall dt (name :: Symbol) ftype exDt.
(HasField dt name ftype, exDt :~> dt) =>
exDt -> Label name -> Expr ftype
#! Label "voidResProxy"
forall a. IsLabel "voidResProxy" a => a
forall (x :: Symbol) a. IsLabel x a => a
#voidResProxy))

-- | Flipped version of 'void_' that is present due to the common
-- appearance of @flip void_ parameter $ instr@ construction.
projectVoid
  :: forall a b voidExpr exb.
  ( KnownValue a
  , IsError (VoidResult b)
  , NiceConstant b
  , voidExpr :~> Void_ a b
  , exb :~> b
  )
  => voidExpr
  -> (Expr a -> IndigoM exb)
  -> IndigoM ()
projectVoid :: voidExpr -> (Expr a -> IndigoM exb) -> IndigoM ()
projectVoid = ((Expr a -> IndigoM exb) -> voidExpr -> IndigoM ())
-> voidExpr -> (Expr a -> IndigoM exb) -> IndigoM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Expr a -> IndigoM exb) -> voidExpr -> IndigoM ()
forall a b voidExpr exb.
(KnownValue a, IsError (VoidResult b), NiceConstant b,
 voidExpr :~> Void_ a b, exb :~> b) =>
(Expr a -> IndigoM exb) -> voidExpr -> IndigoM ()
void_

----------------------------------------------------------------------------
-- Others
----------------------------------------------------------------------------

-- | If the first value is greater than the second one, it returns their
-- difference. If the values are equal, it returns 'Nothing'. Otherwise it
-- fails using the supplied function.
subGt0
  ::(ex1 :~> Natural, ex2 :~> Natural)
  => ex1
  -> ex2
  -> IndigoM ()
  -> IndigoFunction (Maybe Natural)
subGt0 :: ex1 -> ex2 -> IndigoM () -> IndigoFunction (Maybe Natural)
subGt0 minuend :: ex1
minuend subtrahend :: ex2
subtrahend onNegative :: IndigoM ()
onNegative = do
  let
    diff :: Expr Integer
    diff :: Expr Integer
diff = ex1
minuend ex1 -> ex2 -> Expr (ArithResHs Sub Natural Natural)
forall exN exM n m.
IsArithExpr exN exM Sub n m =>
exN -> exM -> Expr (ArithResHs Sub n m)
- ex2
subtrahend

    zero :: Expr Integer
    zero :: Expr Integer
zero = Integer -> Expr Integer
forall a. NiceConstant a => a -> Expr a
C (Integer -> Expr Integer) -> Integer -> Expr Integer
forall a b. (a -> b) -> a -> b
$ 0 NumType 'Int Integer
int

  Expr Bool -> IndigoM () -> IndigoM ()
forall exc. (exc :~> Bool) => exc -> IndigoM () -> IndigoM ()
when (Expr Integer
diff Expr Integer -> Expr Integer -> Expr Bool
forall n c c1.
(NiceComparable n, c :~> n, c1 :~> n) =>
c -> c1 -> Expr Bool
< Expr Integer
zero) IndigoM ()
onNegative

  Var (Maybe Natural)
resVar <- Maybe Natural -> IndigoM (Var (Maybe Natural))
forall ex x. IsExpr ex x => ex -> IndigoM (Var x)
new(Maybe Natural -> IndigoM (Var (Maybe Natural)))
-> Maybe Natural -> IndigoM (Var (Maybe Natural))
forall a b. (a -> b) -> a -> b
$ Maybe Natural
forall a. Maybe a
Nothing

  if Expr Integer
diff Expr Integer -> Expr Integer -> Expr Bool
forall n c c1.
(NiceComparable n, c :~> n, c1 :~> n) =>
c -> c1 -> Expr Bool
== Expr Integer
zero then Var (Maybe Natural) -> Expr (Maybe Natural) -> IndigoM ()
forall ex x. IsExpr ex x => Var x -> ex -> IndigoM ()
setVar Var (Maybe Natural)
resVar (Expr (Maybe Natural) -> IndigoM ())
-> Expr (Maybe Natural) -> IndigoM ()
forall a b. (a -> b) -> a -> b
$ Maybe Natural -> Expr (Maybe Natural)
forall a. NiceConstant a => a -> Expr a
C Maybe Natural
forall a. Maybe a
Nothing else Var (Maybe Natural) -> Expr (Maybe Natural) -> IndigoM ()
forall ex x. IsExpr ex x => Var x -> ex -> IndigoM ()
setVar Var (Maybe Natural)
resVar (Expr (Maybe Natural) -> IndigoM ())
-> Expr (Maybe Natural) -> IndigoM ()
forall a b. (a -> b) -> a -> b
$ Expr Integer -> Expr (Maybe Natural)
forall ex. (ex :~> Integer) => ex -> Expr (Maybe Natural)
isNat Expr Integer
diff

  Var (Maybe Natural) -> IndigoM (Var (Maybe Natural))
forall (m :: * -> *) a. Monad m => a -> m a
return Var (Maybe Natural)
resVar