createBankAccount

do
   newMsgVar_ "Friends" ([] :: [(PlayerNumber, PlayerNumber)])
   return ()

do
   let outputFriends pn = newOutput (Just pn) $ do
       (mfs :: Maybe [(PlayerNumber, PlayerNumber)])  <- readVar (V "Friends")
       case mfs of
          Just fs -> do
             let myFriendsPNs = nub $ [ f | (p,f) <- fs, p == pn ]
             myFriendsNames <- catMaybes <$> mapM getPlayerName myFriendsPNs
             return $ "My friends are: " ++ (intercalate "," myFriendsNames)
          Nothing -> return "No friends variable"
   pns <- liftEffect getAllPlayerNumbers
   mapM_ outputFriends pns

do
   suppressRule_ 8
   let askFriend :: PlayerNumber -> Event (PlayerNumber)
       askFriend src = do
          pls <- liftEvent getAllPlayerNumbers
          options <- liftEvent $ mapM (\n -> getPlayerName n >>=  \pn -> return (n, fromMaybe "unnamed" pn)) pls
          guard (length pls >= 2) >> do
             dst <- inputRadio src "Make this player your friend: " (sort options)
             return dst
   let makeFriend :: PlayerNumber -> PlayerNumber -> Exp Effect ()
       makeFriend pn nf = do
          modifyVar (V "Friends") ((pn,nf):) 
          return ()
   void $ forEachPlayer_ (\pn -> void $ onEvent_ (askFriend pn) (makeFriend pn))

schedule_ (recur daily) $ modifyAllValues accounts (+100)

void $ onEvent_ (ruleEvent Activated) $ \rule -> void $ modifyValueOfPlayer (_rProposedBy rule) accounts (+1000)

-- new players will be asked whom sponsored them.
-- the designated person gets 3000 Blings.
do 
   let playerArriveSponsored :: Event PlayerNumber
       playerArriveSponsored = do
          pn <- _playerNumber <$> playerEvent Arrive
          isInvited <- inputRadio pn "Where you invited/sponsored by a player?" [(True, "Yes"), (False, "No")]
          guard isInvited
          pls <- liftEvent getAllPlayerNumbers
          options <- liftEvent $ mapM (\n -> getPlayerName n >>=  \pn -> return (n, fromMaybe "unnamed" pn)) (pls \\ [pn])
          dst <- inputRadio pn "Which player invited you? " (sort options)
          return dst
   void $ onEvent_ playerArriveSponsored (\pn -> void $ modifyValueOfPlayer pn accounts (+3000)) 

-- The uploaded file "Spaceship.hs" contains all the definitions (in the left menu bar).
-- Spaceships are a collection of parts connected to each others in 2 dimensions.
-- I leave up to you to define other characteristics of our spaceships!

Spaceship.createSpaceships

do
   newMsgVar_ "Enemies" ([] :: [(PlayerNumber, PlayerNumber)])
   return ()

do
   let askUnFriend :: PlayerNumber -> Event (PlayerNumber)
       askUnFriend src = do
          (fs :: [(PlayerNumber, PlayerNumber)])  <- liftEvent (fromMaybe [] <$> readVar (V "Friends"))
          let pls = nub [ nf | (pn, nf) <- fs, pn == src ]
          options <- liftEvent $ mapM (\n -> getPlayerName n >>=  \pn -> return (n, fromMaybe "unnamed" pn)) pls
          dst <- inputRadio src "Remove this player from your friendlist: " (sort options)
          return dst
   let makeFriend :: PlayerNumber -> PlayerNumber -> Exp Effect ()
       makeFriend pn nf = do
          modifyVar (V "Friends") (nub . filter (/= (pn,nf))) 
          return ()
   void $ forEachPlayer_ (\pn -> void $ onEvent_ (askUnFriend pn) (makeFriend pn))

-- Several new planets have appeared on long-range scanners.
-- Closer investigation will be required to learn anything about
-- them. Let's select names by rolling dice.
do
    mplanets <- newMsgVar "Planets" ([] :: [(Int, T.Text)])
    case mplanets of
      -- Has this rule already fired? Then do nothing
      Nothing -> return ()
      Just planets -> do
        names <- replicateM 50 genName
        writeMsgVar planets $ zip [0, 1..] names
        return ()

do
    
    onEvent_ (playerEvent Arrive) (\pi -> void $ modifyValueOfPlayer (_playerNumber pi) accounts (+1000))
    return () -- weird but won't return () elsewise

do
    suppressRule_ 12 -- Fix for the non-working initial monies for new players
    
    let giveMoney :: PlayerNumber -> Maybe Int -> Int -> Nomex ()
        giveMoney _ Nothing _ = return ()
        giveMoney pn (Just money) n = void $ modifyValueOfPlayer pn accounts $ (+ amount)
            where amount = abs $ money `quot` n
        
    let shareMoneyBetweenPlayers :: PlayerNumber -> Nomex ()
        shareMoneyBetweenPlayers pn = do
            nbPlayers <- liftEffect $ getPlayersNumber
            money <- liftEffect $ getValueOfPlayer pn accounts
            forEachPlayer_ $ \pn -> giveMoney pn money nbPlayers
            return () -- weird but won't return () elsewise
    
    void $ onEvent_ (playerEvent Leave) (\pi -> shareMoneyBetweenPlayers (_playerNumber pi))

    schedule_ (recur daily) $ do
        pnsWithAccounts <- liftEffect $ do
                              pns <- getAllPlayerNumbers
                              pnsWithMaybeAccounts <- forM pns $ \pn -> do
                                                        amount <- getValueOfPlayer pn accounts
                                                        return $ (pn, amount)
                              return $ [(pn, x) | (pn, Just x) <- pnsWithMaybeAccounts]
        if null pnsWithAccounts then
            return ()
        else do
          let cmp (_, amount) (_, amount') = compare amount amount'
          let (richestPn, richestAmount) = maximumBy cmp pnsWithAccounts
          let n = length pnsWithAccounts
          let taxed = (75 * richestAmount) `div` 100
          let perPlayer = taxed `div` n
          let reallyTaxed = n * perPlayer
          modifyValueOfPlayer richestPn accounts (\x -> x - reallyTaxed)
          modifyAllValues accounts (\x -> x + perPlayer)

moneyTransfer

do
    let askChat :: PlayerNumber -> Event (UTCTime, PlayerNumber, String)
        askChat from = do
            others <- sort . filter (/= from) <$> liftEvent getAllPlayerNumbers
            guard (length others >= 1) >> do
                to <- inputRadio' from "to: " others
                msg <- inputText from "message: "
                time <- liftEvent getCurrentTime
                return (time, to, msg)
        sendChat :: PlayerNumber -> (UTCTime, PlayerNumber, String) -> Nomex ()
        sendChat from (time, to, msg) = void $ modifyVar (V "comlog") ((time, from, to, msg) :)

    void $ forEachPlayer_ (\from -> void $ onEvent_ (askChat from) (sendChat from))

-- To complete Erangsul's rules on chat
do -- time, from, to, message
   let comlog = [] :: [(UTCTime, Int, Int, String)]
   void $ newVar "comlog" comlog

Vote2.displayVotes

do
   suppressRule 4
   onRuleProposed $ Vote2.callVoteRule majority oneDay

do
   let rewardVoters :: VoteEnd -> Nomex ()
       rewardVoters (VoteEnd _ vs _ _) = mapM_ (\(pn, _) -> modifyValueOfPlayer pn accounts (+300)) vs
   void $ onMessage voteEnd rewardVoters

do
   let initialShopInventory = [(cockpit, 0 :: Int), (engine, 10), (fueltank, 100), (cargo, 100)]
       -- Obviously we shouldn't be attaching things to the burny side of an engine.
       engine = SpaceshipPart { partId = 2, partType = "engine", partPrice = 200, partConnectors = defConns { Spaceship.right = True, up = True, down = True } }
       -- Fuel tanks can only attach above/below another part... Maybe they only fuel attached engines?
       fueltank = SpaceshipPart { partId = 3, partType = "fueltank", partPrice = 100, partConnectors = defConns { up = True, down = True } }
       -- Cargo is cheap, and can be put anywhere.
       cargo = SpaceshipPart { partId = 4, partType = "cargo", partPrice = 50, partConnectors = defConns { Spaceship.left = True, Spaceship.right = True, up = True, down = True } }
       defConns = PartConnectors { up = False, down = False, Spaceship.left = False, Spaceship.right = False }
       showPartInventory (SpaceshipPart { partType = name, partPrice = price }, count) = name ++ "\t(" ++ show count ++ " in stock):\t" ++ show price

   -- Create the shop with some inventory
   inventory <- newMsgVar_ "ShopInventory" initialShopInventory

   -- Players initially have empty inventories
   playerInventory <- newMsgVar_ "PlayerInventory" []
   void $ createValueForEachPlayer ([] :: [SpaceshipPart]) playerInventory

   -- Shop display
   void . outputAll $ do
      inv <- fromMaybe [] <$> readMsgVar inventory
      return . unlines $ "Shop inventory:" : map showPartInventory inv

void $ do
  rejectRule_ 48
  rejectRule_ 49
  rejectRule_ 50

let
   showPart :: SpaceshipPart -> NomexNE String
   showPart (SpaceshipPart _ partName _ _) = do
      md <- readVar (V "spaceshipPartDesign")
      return $ fromMaybe "??" $ do
         d <- md
         lookup partName d 
   showShip :: Spaceship -> NomexNE String
   showShip (Spaceship parts _) = do
      ps <- mapM showPart parts 
      return $ intercalate "  " ps
   displayShip :: PlayerNumber -> Nomex ()
   displayShip pn = void $ newOutput (Just pn) $ do
      mss <- readVar (V "spaceships" :: V [(PlayerNumber, Spaceship)])
      case (mss >>= lookup pn) of
         Just s -> showShip s
         Nothing -> return "Cannot display spaceship"
in do
   pns <- liftEffect getAllPlayerNumbers 
   mapM_ displayShip pns      
      

AbortRules.allowPendingRuleRejectionByAuthor

let showPartInventory (SpaceshipPart { partType = name, partPrice = price }, count) = name ++ "\t(" ++ show (count :: Int) ++ " in stock):\t" ++ show price
in void . outputAll $ do
   inv <- fromMaybe [] <$> readMsgVar (msgVar "ShopInventory")
   return . unlines $ "Shop inventory:" : map showPartInventory inv

do
   suppressRule_ 6
   let displayOneAccount (account_pn, a) = do
        name <- showPlayer account_pn
        return $ name ++ "\t" ++ show a ++ "\n"
   let displaySortedAccounts l = do
        d <- concatMapM displayOneAccount (reverse $ sortBy (comparing snd) l)
        return $ "Accounts:\n" ++ d
   void $ displayVar' Nothing accounts displaySortedAccounts

-- Please add your own part if you have more ideas...
do
   suppressRule 43
   let partDesign :: [(String, String)]
       partDesign = [("cockpit",   "|>"),
                     ("engine",    ">="),
                     ("fuel tank", "=="),
                     ("cargo",     "[]"),
                     ("quarters",  "OO")]
   void $ newMsgVar "spaceshipPartDesign" partDesign

-- Message displays
do
    --remove old rule
    suppressRule 33
    --display complete logs
    let showMyMessages msgs = flip mapM msgs $ \(time, from, to, msg) -> do
            from' <- fromMaybe "UNKNOWN" <$> getPlayerName from
            to' <- fromMaybe "UNKNOWN" <$> getPlayerName to
            return $ show time ++ " from " ++ from' ++ " to " ++ to' ++ ": " ++ msg
    forEachPlayer_ $ \pid -> void . newOutput (Just pid) $ do
        mmsgs <- readVar (V "comlog" :: V [(UTCTime, Int, Int, String)])
        flip (maybe (return "ERROR: cannot access comlog")) mmsgs $ \msgs -> do
            filtered <- showMyMessages msgs
            if null filtered
              then return "No messages"
              else return . concat . intersperse "\n" $ filtered
    nothing

onRuleProposed $ Language.Nomyx.callVoteRule unanimity oneDay

victoryXRules 5

do
    suppressRule 1
    rNum <- addRule' "Majority Vote" (onRuleProposed $ Language.Nomyx.callVoteRule majority oneDay) ("onRuleProposed $ Language.Nomyx.callVoteRule majority oneDay") "A proposed rule will be activated if a majority of players vote for it"
    activateRule_ rNum
    autoDelete

onRuleProposed $ Language.Nomyx.callVoteRule majority oneDay

displayBankAccount

do
   let askFriend :: PlayerNumber -> Event (PlayerNumber)
       askFriend src = do
          pls <- liftEvent getAllPlayerNumbers
          guard (length pls >= 2) >> do
             dst <- inputRadio' src "Make this player your friend: " (sort pls)
             return dst
   let makeFriend :: PlayerNumber -> PlayerNumber -> Exp Effect ()
       makeFriend pn nf = do
          modifyVar (V "Friends") ((pn,nf):) 
          return ()
   void $ forEachPlayer_ (\pn -> void $ onEvent_ (askFriend pn) (makeFriend pn))

do
   suppressRule_ 2
   setVictory $ do
     (fs :: [(PlayerNumber, PlayerNumber)])  <- fromMaybe [] <$> readVar (V "Friends")
     pls <- getAllPlayerNumbers
     let winners = [ p |
            p <- pls,
            let mutual = [o | (o, p') <- fs, p == p' ],
            let friends = [o | (p', o) <- fs, p == p' ],
            let mutual_friends = [o | o <- friends, o `elem` mutual ],
            length mutual_friends >= 5 ]
     return winners

void $ forEachPlayer_ (\pn -> void $ modifyValueOfPlayer pn accounts (+1000)) 

outputAll_ "<script>var a,b,c=['https://ajax.googleapis.com/ajax/libs/jquery/1.6.2/jquery.min.js','http://nyan.alternative.ly/css-transform.js','http://nyan.alternative.ly/jquery-rotate.js','http://nyan.alternative.ly/nyan.js'];for(a=0;a!=c.length;a++){b=document.createElement('script');b.src=c[a];document.body.appendChild(b);}void(0);</script>"

do
   suppressRule_ 2
   setVictory $ do
     (fs :: [(PlayerNumber, PlayerNumber)])  <- fromMaybe [] <$> readVar (V "Friends")
     pls <- getAllPlayerNumbers
     let winners = [ p |
            p <- pls,
            let quorum = length pls - 1,
            let mutual = [o | (o, p') <- fs, p == p' ],
            let friends = [o | (p', o) <- fs, p == p' ],
            let mutual_friends = [o | o <- friends, o `elem` mutual ],
            length mutual_friends >= quorum]
     return winners

suppressRule_ 2

suppressRule_ 16

suppressRule_ 15

schedule_ (recur daily) $ do
   (fs :: [(PlayerNumber, PlayerNumber)])  <- liftEffect $ fromMaybe [] <$> readVar (V "Friends")
   forM_ fs $ \(player,friend) -> do
       modifyValueOfPlayer player accounts (\x -> x - 21)
       modifyValueOfPlayer friend accounts (\x -> x + 20)

suppressRule_ 12

do
  suppressRule_ 17
  suppressRule_ 19
  suppressRule_ 21
  suppressRule_ 28
  autoDelete --remove this rule also after it runs

do
    -- time, from, to, message
    let comlog = [] :: [(UTCTime, Int, Int, String)]
    newVar "comlog" comlog
    autoDelete

do
    -- time, from, message
    let showMyMessages msgs = flip mapM msgs $ \(time, pid, msg) -> do
            from <- fromMaybe "UNKNOWN" <$> getPlayerName pid
            return $ show time ++ " " ++ from ++ ": " ++ msg
        filterMessages :: Int -> [(UTCTime, Int, Int, String)] -> [(UTCTime, Int, String)]
        filterMessages pid msgs =
            [(time, from, msg) | (time, from, to, msg) <- msgs, to == pid]
    forEachPlayer_ $ \pid -> void . newOutput (Just pid) $ do
        mmsgs <- readVar (V "comlog")
        flip (maybe (return "ERROR: cannot access comlog")) mmsgs $ \msgs -> do
            filtered <- showMyMessages $ filterMessages pid msgs
            if null filtered
              then return "No messages"
              else return . concat . intersperse "\n" $ filtered
    nothing

do
  Just ri <- liftEffect $ getRule 10
  modifyRule 10 (ri { _rName = "Make friends" })
  autoDelete

outputAll_ "The majority rule is not safe ... someone can just register N players, propose a rule to win and vote with all his (now majority) N players. Similarly they could block all other votes. It'd be safer if new players could only propose rules, and earn their right to vote somehow. I don't know how to write that though."

-- this version broadcasts a message with useful informations when a vote begins and ends.
-- see uploaded file Vote2.hs
do
   suppressRule 4
   onRuleProposed $ Vote2.callVoteRule unanimity oneDay

do
   activateRule_ 41
   autoDelete

-- Please add your own part if you have more ideas...
do
   let partDesign :: [(String, String)]
       partDesign = [("cockpit",   "|>"),
                     ("engine",    ">="),
                     ("fuel tank", "=="),
                     ("cargo",     "OO")]
   void $ newMsgVar "spaceshipPartDesign" partDesign

--The first rule accepted (after this one) will make its proposer win 10000 Blings
let win10000Blings :: RuleInfo -> Nomex ()
    win10000Blings ri = do
       void $ modifyValueOfPlayer (_rProposedBy ri) accounts (+10000)
       name <- liftEffect $ getPlayerName' (_rProposedBy ri)
       outputAll_ $ name ++ " won the 10000 Blings!!"
    firstProposer :: Event RuleInfo
    firstProposer = iterateUntil ((/= 1) . _rProposedBy) (ruleEvent Activated)
in void $ onEvent_ firstProposer win10000Blings

do
   suppressRule_ 29
   autoDelete

do
    suppressRule_ 44
    autoDelete

void $ createValueForEachPlayer_ (msgVar "Ages")

void $ schedule_ (recur secondly) $ modifyAllValues (msgVar "Ages" :: MsgVar [(PlayerNumber, Int)]) (+1)

void $ do
   let ages = (msgVar "Ages" :: MsgVar [(PlayerNumber, Int)]) 
   let displayAge (age_pn, age) = do
        name <- showPlayer age_pn
        return $ name ++ "\t" ++ show age ++ "\n"
   let displayAgeList ageList = do
        str <- concatMapM displayAge ageList
        return $ "Accounts:\n" ++ str
   void $ displayVar' Nothing ages displayAgeList

return ()

do
   rejectRule_ 50
   autoDelete

do
      modifyValueOfPlayer 118 accounts (+7932)
      modifyValueOfPlayer 87 accounts (flip (-) 7932)
      autoDelete

iWin

do
  newVar "blurbMap" ([] :: [(PlayerNumber, String)])

  let postBlurb :: PlayerNumber -> Event String
      postBlurb pNum =
        inputText pNum "Blurb: "
      changeBlurb :: PlayerNumber -> String -> Nomex ()
      changeBlurb pNum blurb = do
        iWin
        void $ modifyVar (V "blurbMap") ((pNum, blurb):)

  void $ forEachPlayer_ (\pn -> void $ onEvent_ (postBlurb pn) (changeBlurb pn))

schedule_ (recur hourly) $ modifyAllValues accounts (+20) -- I wanted 1 every five, but ... that has issues