Created
July 4, 2014 09:04
-
-
Save tibbe/6a356cd60ef62cea54f6 to your computer and use it in GitHub Desktop.
Fixed Haskell code for http://togototo.wordpress.com/2014/07/04/why-go-is-great-for-servers/
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Control.Monad | |
import Control.Concurrent | |
import Data.Int | |
import System.Environment | |
sendSidewards :: Chan Int -> Chan Int -> IO () | |
sendSidewards from to = do | |
n <- readChan from | |
writeChan to n | |
sendSidewards from to | |
sendLeft :: Chan Int -> IO () | |
sendLeft left = do | |
n <- readChan left | |
writeChan left n | |
sendLeft left | |
makeTrack :: Chan Int -> Int -> IO() | |
makeTrack left nRemaining = | |
if nRemaining > 0 then | |
midTrack left nRemaining | |
else | |
sendLeft left | |
midTrack :: Chan Int -> Int -> IO() | |
midTrack left nRemaining = do | |
right <- newChan | |
forkIO $ makeTrack right (nRemaining - 1) | |
forkIO $ sendSidewards left right | |
sendSidewards right left | |
launchRunner :: Chan Int -> Int -> IO() | |
launchRunner chan num = do | |
writeChan chan num | |
doRace :: Chan Int -> MVar [Int] -> Int -> IO() | |
doRace start resultChan numRunners = do | |
let runners = [1..numRunners] | |
let launchRunnerOnChan = launchRunner start | |
forkIO $ mapM_ launchRunnerOnChan runners | |
finishLine start numRunners [] resultChan | |
finishLine :: Chan Int -> Int -> [Int] -> MVar [Int] -> IO() | |
finishLine inChan remaining results resultChan = | |
if remaining > 0 then do | |
res <- receiveResults inChan | |
finishLine inChan (remaining - 1) (res:results) resultChan | |
else doneResults results resultChan | |
doneResults :: [Int] -> MVar [Int] -> IO() | |
doneResults results resultChan = do | |
putMVar resultChan results | |
receiveResults :: Chan Int -> IO Int | |
receiveResults inChan = readChan inChan | |
main = do | |
(numRunners:numThreads:_) <- getArgs | |
racerA <- newChan | |
racerB <- newChan | |
forkIO $ makeTrack racerA $ read numThreads | |
forkIO $ makeTrack racerB $ read numThreads | |
resultsA <- newEmptyMVar | |
resultsB <- newEmptyMVar | |
forkIO $ doRace racerA resultsA $ read numRunners | |
forkIO $ doRace racerB resultsB $ read numRunners | |
awaitWinner resultsA resultsB | |
awaitWinner :: MVar [Int] -> MVar [Int] -> IO() | |
awaitWinner aChan bChan = do | |
aReady <- varReady aChan | |
if aReady then | |
printWinner aChan "a" | |
else do | |
bReady <- varReady bChan | |
if bReady then | |
printWinner bChan "b" | |
else awaitWinner aChan bChan | |
varReady :: MVar [Int] -> IO Bool | |
varReady var = do | |
empty <- isEmptyMVar var | |
return (not empty) | |
printWinner :: MVar [Int] -> [Char] -> IO() | |
printWinner chan name = do | |
putStrLn (name ++ " won!") | |
nums <- takeMVar chan | |
putStrLn $ show nums |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment