{-# LANGUAGE OverloadedStrings #-} module Example where import Language.Marlowe.Extended import Data.String(fromString) main :: IO () main = print . pretty $ contract 5 refund :: Integer -> Contract -> Contract refund investorIndex next = (Pay (Role "pool") (Party (investorRole investorIndex)) ada (ChoiceValue (ChoiceId "deposit" (investorRole investorIndex))) next) payout :: Integer -> Contract -> Contract payout investorIndex next = (Pay (Role "pool") (Party (investorRole investorIndex)) wtim (MulValue (Constant 10) (ChoiceValue (ChoiceId "deposit" (investorRole investorIndex)))) next) investorRole :: Integer -> Party investorRole idx = Role (fromString ("investor" ++ show idx)) payoutsOrRefunds :: Integer -> Contract payoutsOrRefunds max = If (ValueGT (AvailableMoney (Role "pool") ada) (Constant 50000)) (payoutsRec 1 max) (refundsRec 1 max) payoutsRec :: Integer -> Integer -> Contract payoutsRec current max | current > max = Close | otherwise = payout current (payoutsRec (current + 1) max) refundsRec :: Integer -> Integer -> Contract refundsRec current max | current > max = Close | otherwise = refund current (refundsRec (current + 1) max) safeChoiceAndDepositRec :: Integer -> Integer -> Contract -> Contract safeChoiceAndDepositRec current max next | current > max = next | otherwise = safeChoiceAndDeposit current (safeChoiceAndDepositRec (current + 1) max next) Close safeChoiceAndDeposit :: Integer -> Contract -> Contract -> Contract safeChoiceAndDeposit investorIndex next onTimeout = If (ValueGE (AvailableMoney (Role "pool") wtim ) (Constant 10) ) (choiceAndDeposit investorIndex next onTimeout) Close choiceAndDeposit :: Integer -> Contract -> Contract -> Contract choiceAndDeposit investorIndex next onTimeout = When [Case (Choice (ChoiceId "deposit" (investorRole investorIndex) ) [Bound 10 50000] ) (If (ValueLE (MulValue (Constant 10) (ChoiceValue (ChoiceId "deposit" (investorRole investorIndex) )) ) (AvailableMoney (Role "pool") wtim ) ) (When [Case (Deposit (Role "pool") (investorRole investorIndex) ada (ChoiceValue (ChoiceId "deposit" (investorRole investorIndex) )) ) next] 6000 Close ) Close )] 6000 onTimeout wtim = Token "" "WTIM" contract :: Integer -> Contract contract max = When [Case (Deposit (Role "pool") (Role "startup") wtim (Constant 1000000) ) (safeChoiceAndDeposit 1 (safeChoiceAndDeposit 2 (safeChoiceAndDepositRec 3 max (payoutsOrRefunds max)) (refund 1 Close)) Close)] 10 Close