Program.hs

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

module Indigo.Frontend.Program
  ( IndigoM (..)

  , Program (..)
  , interpretProgram

  , IndigoContract
  ) where

import Control.Monad (liftM)

import Indigo.Frontend.Statement
import Indigo.Internal.Var (HasSideEffects, HasStorage, Var)
import Indigo.Prelude

-- | This is freer monad (in other words operational monad).
--
-- It preserves the structure of the computation performed over it,
-- including @return@ and @bind@ operations.
-- This was introduced to be able to iterate over Indigo code and optimize/analyze it.
--
-- You can read a clearer description of this construction in
-- "The Book of Monads" by Alejandro Serrano.
-- There is a chapter about free monads, specifically about Freer you can read at page 259.
-- There is "operational" package which contains transformer of this monad and
-- auxiliary functions but it's not used because we are using only some basics of it.
data Program instr a where
  Done :: a -> Program instr a
  Instr :: instr a -> Program instr a
  Bind :: Program instr a -> (a -> Program instr b) -> Program instr b

instance Functor (Program instr) where
  fmap = liftM

instance Applicative (Program instr) where
  pure  = Done
  (<*>) = ap

instance Monad (Program instr) where
  return = pure
  (>>=)  = Bind

-- | Traverse over Freer structure and interpret it
interpretProgram
  :: Monad m
  => (forall x . instr x -> m x)
  -> Program instr a -> m a
interpretProgram _ (Done a) = return a
interpretProgram interp (Instr a) = interp a
interpretProgram interp (Bind instr rest) =
  interpretProgram interp instr >>= (interpretProgram interp . rest)

-- | Monad for writing your contracts in.
newtype IndigoM a = IndigoM {unIndigoM :: Program (StatementF IndigoM) a}
  deriving stock (Functor)
  deriving newtype (Applicative, Monad)

-- | Type of a contract that can be compiled to Lorentz with 'compileIndigoContract'.
type IndigoContract param st =
  (HasStorage st, HasSideEffects) => Var param -> IndigoM ()