プログラミング言語Rustの「食事する哲学者」をHaskellで書いてみた

dining-philosophers.hs

module Main where

import           Control.Concurrent       (forkIO, threadDelay)
import           Control.Concurrent.Async
import           Control.Concurrent.MVar

data Philosopher = Philosopher {
    name  :: String
  , left  :: Int
  , right :: Int
} deriving Show

data Table = Table {
    forks :: [MVar ()]
}

eat :: Table -> Philosopher -> IO ()
eat table (Philosopher name left right) = do
  let leftLock  = (forks table) !! left
  let rightLock = (forks table) !! right

  _ <- takeMVar leftLock
  threadDelay (150 * 10 ^ 3)
  _ <- takeMVar rightLock

  putStrLn (name ++ " start eating.")
  threadDelay (1 * 10 ^ 6)
  putStrLn (name ++ " finish eating.")

  putMVar leftLock ()
  putMVar rightLock ()

main :: IO ()
main =
  let ps = [
          Philosopher "Judith Butler" 0 1
        , Philosopher "Gilles Deleuze" 1 2
        , Philosopher "Karl Marx" 2 3
        , Philosopher "Emma Goldman" 3 4
        , Philosopher "Michel Foucault" 0 4
        ]
  in
  do
    mvs <- mapM (\_ -> newMVar ()) [1..5]
    let table = Table mvs
    as  <- mapM (async . eat table) ps
    mapM_ wait as