Message passing concurrency in Haskell with multiple senders and receivers - haskell

Question

I am trying to solve a problem involving multiple senders and receivers, and would like some feedback on whether my approach is on the right track.
Problem: We have N leaders and M followers, who must all be represented by individual threads. Everyone is a dancer, and has an associated "dance card" with the names of 8 different dances. each leader must ask a follower if they can dance a specific dance. Followers wait for invitations from leaders and accept only if they are not already dancing that dance and if they have not agreed to dance with this leader for 2 other dances. If the leaders hears back that their invite was accepted, they move on trying to secure a match for the next dance. Otherwise, they continue trying to find a match for the same dance. At the end, the leaders "dance card" is printed with each dance and the ID of the follower with whom they are dancing that dance.
Approach: I have created two functions: leader and follower. In main, I use forkIO to call leader n times and follower m times. However, I'm running into the issue of how I will keep state (specifically the dancecard). I was thinking of creating a type class "Dancer" and then two instances of it : Leader and Follower. Each leader and each follower would have a unique ID (anything from 1 to N or M). Each would also need an mvar to serve as its own personal mailbox . Leaders would somehow need to "get" a follower's mvar in order to put something in it so that that same follower can take it out and respond yes or no to the invite. Regarding the dancecard, I think it would it be best to incorporate the state monad. For example, when a leader invites a follower to a dance, a follower should be able to look at their dancecard and verify that they don't already have a partner for that dance.

Answer 1

Wow, you already have a typeclass, two instances, and a state monad, and you haven't even settled on the types of your MVars! Things are getting complicated.
I worry that you may be falling into the Haskell-as-Java trap, where you've come up with an object-oriented solution in your head, and you're now trying to translate that directly into Haskell, thinking about your dancers as stateful objects with shared methods wrapped up in a "class", etc., etc.
I would suggest a different approach. Dancers aren't "things"; they're tasks. Implement them as straightforward functions and use argument passing and recursion in place of "state", as is typical for idiomatic Haskell.
Spoilers follow, but here is a simple way to define a "follower" that has an id, responds to requests via a pair of request/response MVars, and maintains a dance card using a recursive core loop. Note that the Follower data type isn't supposed to be a "follower object" (e.g., it has no dance card); it's just a convenient way of documenting the return value from follower which serves as a "handle" for identifying and communicating with the follower task:
type LeaderId = Int
type FollowerId = Int
type Dance = Int
-- |A dance card for a follower with a list of dance/leader pairs.
data Card = Card { getCard :: [(Dance, LeaderId)] } deriving (Show)
emptyCard = Card []
-- |Follower handle giving its id and request/response MVars
data Follower =
Follower { followerId :: FollowerId
, request :: MVar (Dance, LeaderId)
, response :: MVar Bool
}
-- |Create a new follower task with given id.
follower :: FollowerId -> IO Follower
follower followerId_ = do
req <- newEmptyMVar
res <- newEmptyMVar
let loop (Card xs) = do
-- get next request
(dance, leaderId_) <- takeMVar req
case lookup dance xs of
-- if dance is free and we haven't danced too often w/ this leader
Nothing | length (filter ((==leaderId_) . snd) xs) < 2
-- then say yes and update dance card
-> do putMVar res True
loop (Card $ (dance, leaderId_) : xs)
-- otherwise, refuse
_ -> do putMVar res False
loop (Card xs)
forkIO $ loop emptyCard
return $ Follower followerId_ req res
You can create and test out a couple of followers by asking them to dance:
> f1 <- follower 1 -- follower #1
> f2 <- follower 2 -- follower #2
> putMVar (request f1) (1, 10) -- dance #1 w/ leader #10
> takeMVar (response f1)
True -- hooray!
> putMVar (request f1) (1, 14) -- dance #1 w/ leader #14
> takeMVar (response f1)
False -- wah! dance is taken
> putMVar (request f2) (1, 14) -- try different follower
> takeMVar (response f2)
True -- hooray!
>
Note that these particular followers can neither be queried for their dance cards nor told to exit their infinite loops. You don't need that for this application (we only need the dance cards from the leaders and don't care if there are a bunch of stuck lightweight threads when we get the answer), but you could always add a couple of MVars if you did.
Similarly, you should be able to implement a leader as a function with a simple recursive core loop. Note that, if the leader tries to just fill its dance card in order, it doesn't actually need to keep track of the dance card as it goes -- the final dance card (and "core loop") is just a mapM over trying to fill dance slots 1 to 8.
How do you provide the leaders with the ability to request dances from followers? Well, create the full set of followers first and pass a list of follower handles ([Follower]) as an argument to the leader creation function. How do you get dance cards back from the leaders? The leader function should return an MVar for the card, and the main function can mapM takeMVar leadersDanceCards to get the full list of dance cards.