Backend.hs

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

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Strictly typed statements of Indigo language.

module Indigo.Backend
  ( module ReExports

  -- * Loop
  , forEach
  , while
  , whileLeft

  -- * Contract call
  , selfCalling
  , contractCalling

  -- * Documentation
  , doc
  , docGroup
  , docStorage
  , contractName
  , finalizeParamCallingDoc
  , contractGeneral
  , contractGeneralDefault

  -- * Side-effects
  , transferTokens
  , setDelegate

  -- * Functions, Procedures and Scopes
  , scope

  -- * Comments
  , comment

  -- * Conversion from Lorentz
  , fromLorentzFun1
  , fromLorentzFun2
  , fromLorentzFun3
  , fromLorentzFun1Void
  , fromLorentzFun2Void
  , fromLorentzFun3Void
  ) where

import Indigo.Backend.Case as ReExports
import Indigo.Backend.Conditional as ReExports
import Indigo.Backend.Error as ReExports
import Indigo.Backend.Lambda as ReExports
import Indigo.Backend.Scope as ReExports
import Indigo.Backend.Var as ReExports

import Indigo.Backend.Prelude
import Indigo.FromLorentz
import Indigo.Internal
import Indigo.Lorentz
import qualified Lorentz.Doc as L
import qualified Lorentz.EntryPoints.Doc as L (finalizeParamCallingDoc)
import Lorentz.EntryPoints.Helpers (RequireSumType)
import qualified Lorentz.Instr as L
import qualified Michelson.Typed as MT
import Util.Type (type (++))

----------------------------------------------------------------------------
-- Loop
----------------------------------------------------------------------------

-- | While statement. The same rule about releasing.
while :: forall inp xs ex . ex :~> Bool => ex -> IndigoState inp xs () -> IndigoState inp inp ()
while e body = IndigoState $ \md ->
  let expCd = gcCode $ runIndigoState (compileToExpr e) md in
  let bodyIndigoState = cleanGenCode $ runIndigoState body md in
  GenCode () md (expCd # L.loop (bodyIndigoState # expCd)) L.nop

whileLeft
  :: forall inp xs ex l r .
     ( ex :~> Either l r
     , KnownValue l
     , KnownValue r
     )
  => ex
  -> (Var l -> IndigoState (l & inp) xs ())
  -> IndigoState inp (r & inp) (Var r)
whileLeft e body = IndigoState $ \md ->
  let
    cde = gcCode $ runIndigoState (compileToExpr e) md
    (l, newMd) = pushRefMd md
    gc = cleanGenCode $ runIndigoState (body l) newMd
    (r, resMd) = pushRefMd md
  in GenCode r resMd (cde # L.loopLeft (gc # L.drop # cde)) L.drop

-- | For statements to iterate over container.
forEach
  :: forall a e inp xs. (IterOpHs a, KnownValue (IterOpElHs a), e :~> a)
  => e -> (Var (IterOpElHs a) -> IndigoState ((IterOpElHs a) & inp) xs ())
  -> IndigoState inp inp ()
forEach container body = IndigoState $ \md ->
  let cde = gcCode $ runIndigoState (compileToExpr container) md in
  let (var, newMd) = pushRefMd md in
  let bodyIndigoState = cleanGenCode $ runIndigoState (body var) newMd in
  GenCode () md (cde # L.iter (bodyIndigoState # L.drop)) L.nop

----------------------------------------------------------------------------
-- Documentation
----------------------------------------------------------------------------

-- | Put a document item.
doc :: DocItem di => di -> IndigoState s s ()
doc di = IndigoState \md -> GenCode () md (L.doc di) L.nop

-- | Group documentation built in the given piece of code
-- into block dedicated to one thing, e.g. to one entrypoint.
docGroup :: DocGrouping -> IndigoState i o () -> IndigoState i o ()
docGroup gr ii = IndigoState $ \md ->
  let GenCode _ mdii cd clr = runIndigoState ii md in
  GenCode () mdii (L.docGroup gr cd) clr

-- | Insert documentation of the contract storage type. The type
-- should be passed using type applications.
docStorage :: forall storage s. TypeHasDoc storage => IndigoState s s ()
docStorage = IndigoState \md -> GenCode () md (L.docStorage @storage) L.nop

-- | Give a name to given contract. Apply it to the whole contract code.
contractName :: Text -> IndigoState i o () -> IndigoState i o ()
contractName cName b = IndigoState $ \md ->
  let GenCode _ mdb gc clr = runIndigoState b md in
  GenCode () mdb (L.contractName cName gc) clr

-- | Attach general info to given contract.
contractGeneral :: IndigoState i o () -> IndigoState i o ()
contractGeneral b = IndigoState $ \md ->
  let GenCode _ mdb gc clr = runIndigoState b md in
  GenCode () mdb (L.contractGeneral gc) clr

-- | Attach default general info to the contract documentation.
contractGeneralDefault :: IndigoState s s ()
contractGeneralDefault =
  IndigoState \md -> GenCode () md L.contractGeneralDefault L.nop

-- | Indigo version for the function of the same name from Lorentz.
finalizeParamCallingDoc
  :: forall cp param inp out x. (param :~> cp, NiceParameterFull cp, RequireSumType cp, HasCallStack)
  => (Var cp -> IndigoState (cp & inp) out x)
  -> (param -> IndigoState inp out x)
finalizeParamCallingDoc act param = IndigoState $ \md ->
  let cde = gcCode $ runIndigoState (compileToExpr param) md in
  let (var, newMd) = pushRefMd md in
  let GenCode x md1 cd clr = runIndigoState (act var) newMd in
  GenCode x md1 (cde # L.finalizeParamCallingDoc cd) (clr # L.drop)

----------------------------------------------------------------------------
-- Contract call
----------------------------------------------------------------------------

selfCalling
  :: forall p inp mname.
     ( NiceParameterFull p
     , KnownValue (GetEntryPointArgCustom p mname)
     )
  => EntryPointRef mname
  -> IndigoState inp (ContractRef (GetEntryPointArgCustom p mname) & inp)
                     (Var (ContractRef (GetEntryPointArgCustom p mname)))
selfCalling epRef = do
  nullaryOp (L.selfCalling @p epRef)
  makeTopVar

contractCalling
  :: forall cp inp epRef epArg addr exAddr.
     ( HasEntryPointArg cp epRef epArg
     , ToTAddress cp addr
     , ToT addr ~ ToT Address
     , IsExpr exAddr addr
     , KnownValue epArg
     )
  => epRef -> exAddr
  -> IndigoState inp (Maybe (ContractRef epArg) & inp) (Var (Maybe (ContractRef epArg)))
contractCalling epRef addr = do
  unaryOp addr (L.contractCalling @cp epRef)
  makeTopVar

----------------------------------------------------------------------------
-- Side-effects
----------------------------------------------------------------------------

transferTokens
  :: (IsExpr exp p, IsExpr exm Mutez, IsExpr exc (ContractRef p), NiceParameter p, HasSideEffects)
  => exp -> exm -> exc -> IndigoState inp inp ()
transferTokens ep em ec = do
  MetaData s _ <- iget
  ternaryOpFlat ep em ec (L.transferTokens # varActionOperation s)

setDelegate :: (HasSideEffects, IsExpr ex (Maybe KeyHash)) => ex -> IndigoState inp inp ()
setDelegate e =  do
  MetaData s _ <- iget
  unaryOpFlat e (L.setDelegate # varActionOperation s)

----------------------------------------------------------------------------
-- Functions, Procedures and Scopes
----------------------------------------------------------------------------

-- | Takes an arbitrary 'IndigoM' and wraps it into an 'IndigoFunction'
-- producing a local scope for its execution. Once it executed, all
-- non-returned variables are cleaned up so that the stack has only
-- returned variables at the top. This also can be interpreted as
-- @if True then f else nop@.
--
-- Note, that by default we do not define scope inside indigo functions,
-- meaning that once we want to create a new variable or return it from
-- a function we need to do it inside @scope $ instr@ construction, for
-- example:
--
-- @
-- f :: IndigoFunction s Natural
-- f = scope $ do
--   *[s]*
--   res <- newVar (0 :: Natural)
--   *[Natural, s]*
--   scope $ do
--     _n <- newVar (1 :: Integer)
--     *[Integer, Natural, s]
--     res += 4
--   *[Natural, s]*
--   return res
--   *[s]*
-- @
scope
  :: forall a inp out . ScopeCodeGen a
  => IndigoState inp out a
  -> IndigoState inp (RetOutStack a ++ inp) (RetVars a)
scope f = IndigoState $ \md ->
  let gc = runIndigoState f md in
  finalizeStatement @a md (compileScope gc)

-- | Add a comment
comment :: MT.CommentType -> IndigoState i i ()
comment t = IndigoState $ \md -> GenCode () md (L.comment t) L.nop

----------------------------------------------------------------------------
-- Conversion from Lorentz
----------------------------------------------------------------------------

-- Functions that convert Lorentz code to Indigo.
-- Will be removed when all Lorentz code is translated in Indigo.

$(genFromLorentzFunN 3)