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
  ) 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 Michelson.Typed as MT
import Util.Type (type (++))

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

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

whileLeft
  :: (KnownValue l, KnownValue r)
  => Expr (Either l r)
  -> (Var l -> IndigoState (l & inp) xs ())
  -> IndigoState inp (r & inp) (Var r)
whileLeft e body = IndigoState $ \md ->
  let
    cde = gcCode $ runIndigoState (compileExpr 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
  :: (IterOpHs a, KnownValue (IterOpElHs a))
  => Expr a -> (Var (IterOpElHs a) -> IndigoState ((IterOpElHs a) & inp) xs ())
  -> IndigoState inp inp ()
forEach container body = IndigoState $ \md ->
  let cde = gcCode $ runIndigoState (compileExpr 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
  :: (NiceParameterFull cp, RequireSumType cp, HasCallStack)
  => (Var cp -> IndigoState (cp & inp) out x)
  -> (Expr cp -> IndigoState inp out x)
finalizeParamCallingDoc act param = IndigoState $ \md ->
  let cde = gcCode $ runIndigoState (compileExpr 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.
     ( HasEntrypointArg cp epRef epArg
     , ToTAddress cp addr
     , ToT addr ~ ToT Address
     , KnownValue epArg
     )
  => epRef -> Expr addr
  -> IndigoState inp (Maybe (ContractRef epArg) & inp) (Var (Maybe (ContractRef epArg)))
contractCalling epRef addr = do
  unaryOp addr (L.contractCalling @cp epRef)
  makeTopVar

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

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

setDelegate :: HasSideEffects => Expr (Maybe KeyHash) -> 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