Editing Shootout/Chameneos (section)

== Josh Goldfoot ==

Josh submitted the first haskell entry:

<haskell>
{-  The Great Computer Language Shootout
    http://shootout.alioth.debian.org/
    contributed by Josh Goldfoot
-}

import Control.Concurrent
import System(getArgs)

data Color = Blue | Red | Yellow | Faded deriving (Eq, Show)
data MeetingPlace = MeetingPlace { first :: Maybe Color, second :: Maybe (MVar Color), meetingsLeft :: Int }
data Creature = Creature {meetings :: Int, color :: Color, mp :: MVar MeetingPlace}

main = do
   [nstring] <- getArgs
   theMeetingPlace <- newMVar MeetingPlace { first = Nothing, second = Nothing, meetingsLeft = (read nstring) }
   result1 <- newEmptyMVar  -- Create MVars, through which the 4 creature threads will report their # of meetings
   result2 <- newEmptyMVar
   result3 <- newEmptyMVar
   result4 <- newEmptyMVar
   let creatures = [runCreature Creature { meetings = 0, color = col, mp = theMeetingPlace } res | (col, res) <-
                     [ (Blue, result1), (Red, result2), (Yellow, result3), (Blue, result4)]]
   mapM forkIO creatures  -- This one line starts the 4 "creature" threads
   d1 <- takeMVar result1 -- This waits until the 1st creature thread reports a result
   d2 <- takeMVar result2
   d3 <- takeMVar result3
   d4 <- takeMVar result4
   print (sum [d1, d2, d3, d4]) -- We have all 4 results; sum them, and print.

runCreature creature resultVar
   | (color creature) == Faded = putMVar resultVar ((meetings creature) - 1)  -- If we are faded, report & die
   | otherwise = do
      mpdata <- takeMVar (mp creature)  -- Waits for there to be a meeting place variable to take
      if (first mpdata) == Nothing
         then do  -- The meeting place is empty.  Let the next guy know how to find us.
            secondCreatureColor <- newEmptyMVar
            putMVar (mp creature) MeetingPlace { first = Just (color creature), second = Just secondCreatureColor, meetingsLeft = (meetingsLeft mpdata) }
            secondCreatureColorData <- takeMVar secondCreatureColor
            putMVar (mp creature) MeetingPlace { first = Nothing, second = Nothing, meetingsLeft = decrement (meetingsLeft mpdata) }
            runCreature Creature { meetings = (meetings creature) + 1,
               color = newColor (meetingsLeft mpdata) (color creature) (Just secondCreatureColorData),
               mp = (mp creature) } resultVar
         else do -- We are the second creature here.  Let the first guy know we arrived.
            putMVar (unjust (second mpdata)) (color creature)
            runCreature Creature { meetings = (meetings creature) + 1,
               color = newColor (meetingsLeft mpdata) (color creature) (first mpdata),
               mp = (mp creature) } resultVar

newColor 0 _ _ = Faded
newColor _ me (Just other) = complement me other

unjust (Just x) = x

complement me other
   | other == Faded = Faded
   | me == other = me
   | me == Blue = if other == Red then Yellow else Red
   | me == Red = if other == Blue then Yellow else Blue
   | me == Yellow = if other == Blue then Red else Blue
   | me == Faded = Faded

decrement 0 = 0
decrement n = n - 1
</haskell>