Add simple load balancer.

diff --git a/Network/YAML/Balancer.hs b/Network/YAML/Balancer.hs
new file mode 100644
index 0000000..86d4fd0
--- /dev/null
+++ b/Network/YAML/Balancer.hs
@@ -0,0 +1,16 @@
+
+module Network.YAML.Balancer where
+
+import System.Random
+import qualified Data.ByteString.Char8 as BS
+
+type Server = (BS.ByteString, Int)
+
+selectRandom :: [(BS.ByteString, Server, Int)] -> BS.ByteString -> IO Server
+selectRandom lst service = do
+  let lst' = concatMap (\(name,srv,p) -> replicate p (name, srv)) lst
+      lst'' = map snd $ filter (\(name,srv) -> name==service) lst'
+      n = length lst''
+  k <- randomRIO (0, n-1)
+  return $ lst'' !! k
+
diff --git a/Network/YAML/Caller.hs b/Network/YAML/Caller.hs
index 3f037c5..e21ba80 100644
--- a/Network/YAML/Caller.hs
+++ b/Network/YAML/Caller.hs
@@ -54,6 +54,7 @@ callF :: (IsYamlObject a, IsYamlObject b)
       -> IO ()
 callF getServer service name (args, var) = do
   srv <- getServer service
+--   putStrLn $ "Calling to " ++ show srv
   r <- call srv name args
   putMVar var r

diff --git a/Network/YAML/Server.hs b/Network/YAML/Server.hs
index 9a3f289..0907254 100644
--- a/Network/YAML/Server.hs
+++ b/Network/YAML/Server.hs
@@ -13,6 +13,17 @@ import Data.Object.Yaml
 import Network.YAML.Base
 import Network.YAML.Instances

+forkA :: [IO a] -> IO [a]
+forkA lst = do
+    let n = length lst
+    vars <- replicateM n newEmptyMVar
+    mapM (forkIO . run) $ zip lst vars
+    mapM takeMVar vars
+  where
+    run (x,v) = do
+      r <- x
+      putMVar v r
+
 readHandle :: Handle -> [BS.ByteString] -> IO [BS.ByteString]
 readHandle h acc = do
     line <- BS.hGetLine h
diff --git a/Test.hs b/Test.hs
index 4ce1668..1421dbd 100644
--- a/Test.hs
+++ b/Test.hs
@@ -3,10 +3,12 @@
 import Data.Object.Yaml
 import Data.Convertible.Base
 import qualified Data.Map as M
+import Control.Concurrent

 import Network.YAML.Dispatcher
 import Network.YAML.Base
 import Network.YAML.Instances
+import Network.YAML.Server (forkA)

 import TestTypes

@@ -21,5 +23,7 @@ rules = mkRules [("double", yamlMethod double),

 main = do
   putStrLn "Listening..."
-  dispatcher 5000 rules
+  forkA [dispatcher 5000 rules,
+         dispatcher 5001 rules,
+         dispatcher 5002 rules]
   return ()
diff --git a/TestCall.hs b/TestCall.hs
index 380243a..b21aeda 100644
--- a/TestCall.hs
+++ b/TestCall.hs
@@ -6,11 +6,15 @@ import Data.Convertible.Base
 import Network.YAML.Base
 import Network.YAML.Instances
 import Network.YAML.Caller
+import Network.YAML.Balancer

 import TestTypes

-getService "test" = return ("127.0.0.1", 5000)
-getService _ = fail "Unknown service"
+rules = [("test", ("127.0.0.1", 5000), 1),
+         ("test", ("127.0.0.1", 5001), 1),
+         ("test", ("127.0.0.1", 5002), 1)]
+
+getService = selectRandom rules

 p = Point 2.0 3.0