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
  , createContract

  -- * Functions, Procedures and Scopes
  , scope

  -- * Comments
  , comment
  ) 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.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 Lorentz.Run as L
import qualified Michelson.Typed as MT
import Util.Type (type (++))

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

-- | While statement.
while
  :: Expr Bool
  -- ^ Expression for the control flow
  -> SomeIndigoState inp
  -- ^ Block of code to execute, as long as the expression holds 'True'
  -> IndigoState inp inp
while e body = IndigoState $ \md ->
  let expCd = gcCode $ usingIndigoState md (compileExpr e)
      bodyIndigoState = runSIS body md cleanGenCode
  in GenCode (mdStack md) (expCd # L.loop (bodyIndigoState # expCd)) L.nop

-- | While-left statement. Repeats a block of code as long as the control
-- 'Either' is 'Left', returns when it is 'Right'.
whileLeft
  :: (KnownValue l, KnownValue r)
  => Expr (Either l r)
  -- ^ Expression for the control flow value
  -> Var l
  -- ^ Variable for the 'Left' value (available to the code block)
  -> SomeIndigoState (l & inp)
  -- ^ Code block to execute while the value is 'Left'
  -> Var r
  -- ^ Variable that will be assigned to the resulting value
  -> IndigoState inp (r & inp)
whileLeft e varL body varR = IndigoState $ \md ->
  let
    cde = gcCode $ usingIndigoState md (compileExpr e)
    newMd = pushRefMd varL md
    gc = runSIS body newMd cleanGenCode
    resSt = pushRef varR $ mdStack md
  in GenCode resSt (cde # L.loopLeft (gc # L.drop # cde)) L.drop

-- | For statements to iterate over a container.
forEach
  :: (IterOpHs a, KnownValue (IterOpElHs a))
  => Expr a
  -- ^ Expression for the container to traverse
  -> Var (IterOpElHs a)
  -- ^ Variable for the current item (available to the code block)
  -> SomeIndigoState ((IterOpElHs a) & inp)
  -- ^ Code block to execute over each element of the container
  -> IndigoState inp inp
forEach container var body = IndigoState $ \md ->
  let cde = gcCode $ usingIndigoState md (compileExpr container)
      newMd = pushRefMd var md
      bodyIndigoState = runSIS body newMd cleanGenCode
  in GenCode (mdStack 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 (mdStack md) (L.doc di) L.nop

-- | Group documentation built in the given piece of code
-- into a block dedicated to one thing, e.g. to one entrypoint.
docGroup :: DocGrouping -> SomeIndigoState i -> SomeIndigoState i
docGroup gr = overSIS $ \(GenCode md cd clr) -> SomeGenCode $
  GenCode md (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 (mdStack md) (L.docStorage @storage) L.nop

-- | Give a name to the given contract. Apply it to the whole contract code.
contractName :: Text -> SomeIndigoState i -> SomeIndigoState i
contractName cName = overSIS $ \(GenCode mdb gc clr) ->
  SomeGenCode $ GenCode mdb (L.contractName cName gc) clr

-- | Attach general info to the given contract.
contractGeneral :: SomeIndigoState i -> SomeIndigoState i
contractGeneral = overSIS $ \(GenCode mdb gc clr) ->
  SomeGenCode $ GenCode mdb (L.contractGeneral gc) clr

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

-- | Indigo version for the function of the same name from Lorentz.
finalizeParamCallingDoc
  :: (NiceParameterFull cp, RequireSumType cp, HasCallStack)
  => Var cp
  -> SomeIndigoState (cp & inp)
  -> Expr cp
  -> SomeIndigoState inp
finalizeParamCallingDoc vc act param = SomeIndigoState $ \md ->
  let cde = gcCode $ usingIndigoState md (compileExpr param)
      newMd = pushRefMd vc md
  in runSIS act newMd $ \(GenCode st1 cd clr) ->
    SomeGenCode $ GenCode st1 (cde # L.finalizeParamCallingDoc cd) (clr # L.drop)

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

selfCalling
  :: forall p inp mname.
     ( NiceParameterFull p
     , KnownValue (GetEntrypointArgCustom p mname)
     )
  => EntrypointRef mname
  -> Var (ContractRef (GetEntrypointArgCustom p mname))
  -- ^ Variable that will be assigned to the resulting 'ContractRef'
  -> IndigoState inp (ContractRef (GetEntrypointArgCustom p mname) & inp)
selfCalling epRef var = do
  nullaryOp (L.selfCalling @p epRef)
  assignTopVar var

contractCalling
  :: forall cp inp epRef epArg addr.
     ( HasEntrypointArg cp epRef epArg
     , ToTAddress cp addr
     , ToT addr ~ ToT Address
     , KnownValue epArg
     )
  => epRef
  -> Expr addr
  -> Var (Maybe (ContractRef epArg))
  -- ^ Variable that will be assigned to the resulting 'ContractRef'
  -> IndigoState inp (Maybe (ContractRef epArg) & inp)
contractCalling epRef addr var = do
  unaryOp addr (L.contractCalling @cp epRef)
  assignTopVar var

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

transferTokens
  :: (NiceParameter p, HasSideEffects)
  => Expr p -> Expr Mutez -> Expr (ContractRef p)
  -> IndigoState inp inp
transferTokens ep em ec = withStackVars $ \s ->
  ternaryOpFlat ep em ec (L.transferTokens # varActionOperation s)

setDelegate :: HasSideEffects => Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate e = withStackVars $ \s ->
  unaryOpFlat e (L.setDelegate # varActionOperation s)

createContract
  :: (HasSideEffects, NiceStorage s, NiceParameterFull p)
  => L.Contract p s
  -> Expr (Maybe KeyHash)
  -> Expr Mutez
  -> Expr s
  -> Var Address
  -- ^ Variable that will be assigned to the resulting 'Address'
  -> IndigoState inp (Address & inp)
createContract lCtr ek em es var = do
  withStackVars $ \s ->
    ternaryOp ek em es $ L.createContract lCtr # varActionOperation (NoRef :& s)
  assignTopVar var

----------------------------------------------------------------------------
-- 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 ret inp . ScopeCodeGen ret
  => SomeIndigoState inp
  -- ^ Code block to execute inside the scope
  -> ret
  -- ^ Return value(s) of the scoped code block
  -> RetVars ret
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack ret ++ inp)
scope f ret retVars = IndigoState $ \md@MetaData{..} ->
  runSIS f md $ \fs -> finalizeStatement @ret mdStack retVars $ compileScope @ret mdObjects fs ret

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