module Nomyx.Library.Bank where
import Prelude
import Data.Time.Recurrence as X hiding (filter)
import Data.List as X
import Data.Maybe
import Control.Monad as X
import Safe (readDef)
import Nomyx.Language
accounts :: V [(PlayerNumber, Int)]
accounts = V "Accounts"
createBankAccounts :: Rule
createBankAccounts = void $ createValueForEachPlayer_ accounts
depositAPI :: APICall (PlayerNumber, Int) Bool
depositAPI = APICall "deposit"
withdrawAPI :: APICall (PlayerNumber, Int) Bool
withdrawAPI = APICall "withdraw"
balanceAPI :: APICall PlayerNumber (Maybe Int)
balanceAPI = APICall "getBalance"
bankServices :: Nomex ()
bankServices = do
void $ onAPICall depositAPI deposit
void $ onAPICall withdrawAPI withdraw
void $ onAPICall balanceAPI getBalance
deposit :: (PlayerNumber, Int) -> Nomex Bool
deposit (pn, amount) = do
if amount > 0 then modifyValueOfPlayer pn accounts (+ amount)
else return False
withdraw :: (PlayerNumber, Int) -> Nomex Bool
withdraw (pn, amount) = do
balance <- getValueOfPlayer pn accounts
if (amount > 0 && fromJust balance >= amount) then modifyValueOfPlayer pn accounts (\a -> a amount)
else return False
getBalance :: PlayerNumber -> Nomex (Maybe Int)
getBalance pn = getValueOfPlayer pn accounts
displayBankAccounts :: Rule
displayBankAccounts = do
let displayOneAccount (account_pn, a) = do
name <- showPlayer account_pn
return $ name ++ "\t" ++ show a ++ "\n"
let displayAccounts l = do
d <- concatMapM displayOneAccount l
return $ "Accounts:\n" ++ d
void $ displayVar' Nothing accounts displayAccounts
winXEcuPerDay :: Int -> Rule
winXEcuPerDay x = schedule_ (recur daily) $ modifyAllValues accounts (+x)
winXEcuOnRuleAccepted :: Int -> Rule
winXEcuOnRuleAccepted x = void $ onEvent_ (ruleEvent Activated) $ \rule -> void $ modifyValueOfPlayer (_rProposedBy rule) accounts (+x)
moneyTransfer :: Rule
moneyTransfer = do
let askAmount :: PlayerNumber -> Event (PlayerNumber, Int)
askAmount src = do
pls <- liftEvent getAllPlayerNumbers
guard (length pls >= 2) >> do
let pnames = map (\a -> (a, show a)) (delete src $ sort pls)
dst <- inputRadio src "Transfer money to player: " pnames
amount <- inputText src ("Select Amount to transfert to player " ++ show dst ++ ": ")
return (dst, readDef 0 amount)
void $ forEachPlayer_ (\pn -> void $ onEvent_ (askAmount pn) (transfer pn))
transfer :: PlayerNumber -> (PlayerNumber, Int) -> Nomex ()
transfer src (dst, amount) = do
withdrawOK <- callAPIBlocking withdrawAPI (src, amount)
if withdrawOK then do
depositOK <- callAPIBlocking depositAPI (dst, amount)
if depositOK then do
void $ newOutput_ (Just src) ("You transfered " ++ (show amount) ++ " ecu(s) to player " ++ (show dst))
void $ newOutput_ (Just dst) ("You received " ++ (show amount) ++ " ecu(s) from player " ++ (show src))
else do
callAPIBlocking depositAPI (src, amount)
void $ newOutput_ (Just src) ("Transaction failed")
else do
void $ newOutput_ (Just src) ("Insufficient balance or wrong amount")