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

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

  , Program (..)
  , interpretProgram
  ) where

import Control.Monad (liftM)
import Prelude

import Indigo.Frontend.Statement

-- | 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 :: (a -> b) -> Program instr a -> Program instr b
fmap = (a -> b) -> Program instr a -> Program instr b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (Program instr) where
  pure :: a -> Program instr a
pure  = a -> Program instr a
forall a (instr :: * -> *). a -> Program instr a
Done
  <*> :: Program instr (a -> b) -> Program instr a -> Program instr b
(<*>) = Program instr (a -> b) -> Program instr a -> Program instr b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Program instr) where
  return :: a -> Program instr a
return = a -> Program instr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: Program instr a -> (a -> Program instr b) -> Program instr b
(>>=)  = Program instr a -> (a -> Program instr b) -> Program instr b
forall (instr :: * -> *) a b.
Program instr a -> (a -> Program instr b) -> Program instr b
Bind

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

-- | Monad for writing your contracts in.
newtype IndigoM a = IndigoM {IndigoM a -> Program (StatementF IndigoM) a
unIndigoM :: Program (StatementF IndigoM) a}
  deriving stock (a -> IndigoM b -> IndigoM a
(a -> b) -> IndigoM a -> IndigoM b
(forall a b. (a -> b) -> IndigoM a -> IndigoM b)
-> (forall a b. a -> IndigoM b -> IndigoM a) -> Functor IndigoM
forall a b. a -> IndigoM b -> IndigoM a
forall a b. (a -> b) -> IndigoM a -> IndigoM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IndigoM b -> IndigoM a
$c<$ :: forall a b. a -> IndigoM b -> IndigoM a
fmap :: (a -> b) -> IndigoM a -> IndigoM b
$cfmap :: forall a b. (a -> b) -> IndigoM a -> IndigoM b
Functor)
  deriving newtype (Functor IndigoM
a -> IndigoM a
Functor IndigoM =>
(forall a. a -> IndigoM a)
-> (forall a b. IndigoM (a -> b) -> IndigoM a -> IndigoM b)
-> (forall a b c.
    (a -> b -> c) -> IndigoM a -> IndigoM b -> IndigoM c)
-> (forall a b. IndigoM a -> IndigoM b -> IndigoM b)
-> (forall a b. IndigoM a -> IndigoM b -> IndigoM a)
-> Applicative IndigoM
IndigoM a -> IndigoM b -> IndigoM b
IndigoM a -> IndigoM b -> IndigoM a
IndigoM (a -> b) -> IndigoM a -> IndigoM b
(a -> b -> c) -> IndigoM a -> IndigoM b -> IndigoM c
forall a. a -> IndigoM a
forall a b. IndigoM a -> IndigoM b -> IndigoM a
forall a b. IndigoM a -> IndigoM b -> IndigoM b
forall a b. IndigoM (a -> b) -> IndigoM a -> IndigoM b
forall a b c. (a -> b -> c) -> IndigoM a -> IndigoM b -> IndigoM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: IndigoM a -> IndigoM b -> IndigoM a
$c<* :: forall a b. IndigoM a -> IndigoM b -> IndigoM a
*> :: IndigoM a -> IndigoM b -> IndigoM b
$c*> :: forall a b. IndigoM a -> IndigoM b -> IndigoM b
liftA2 :: (a -> b -> c) -> IndigoM a -> IndigoM b -> IndigoM c
$cliftA2 :: forall a b c. (a -> b -> c) -> IndigoM a -> IndigoM b -> IndigoM c
<*> :: IndigoM (a -> b) -> IndigoM a -> IndigoM b
$c<*> :: forall a b. IndigoM (a -> b) -> IndigoM a -> IndigoM b
pure :: a -> IndigoM a
$cpure :: forall a. a -> IndigoM a
$cp1Applicative :: Functor IndigoM
Applicative, Applicative IndigoM
a -> IndigoM a
Applicative IndigoM =>
(forall a b. IndigoM a -> (a -> IndigoM b) -> IndigoM b)
-> (forall a b. IndigoM a -> IndigoM b -> IndigoM b)
-> (forall a. a -> IndigoM a)
-> Monad IndigoM
IndigoM a -> (a -> IndigoM b) -> IndigoM b
IndigoM a -> IndigoM b -> IndigoM b
forall a. a -> IndigoM a
forall a b. IndigoM a -> IndigoM b -> IndigoM b
forall a b. IndigoM a -> (a -> IndigoM b) -> IndigoM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> IndigoM a
$creturn :: forall a. a -> IndigoM a
>> :: IndigoM a -> IndigoM b -> IndigoM b
$c>> :: forall a b. IndigoM a -> IndigoM b -> IndigoM b
>>= :: IndigoM a -> (a -> IndigoM b) -> IndigoM b
$c>>= :: forall a b. IndigoM a -> (a -> IndigoM b) -> IndigoM b
$cp1Monad :: Applicative IndigoM
Monad)