Support for parallel execution of method on many servers
Support for parallel execution of method on many servers
diff --git a/Network/YAML/Caller.hs b/Network/YAML/Caller.hs
index 00c39b8..3f037c5 100644
--- a/Network/YAML/Caller.hs
+++ b/Network/YAML/Caller.hs
@@ -8,6 +8,8 @@ import Data.Convertible.Base
import qualified Data.ByteString.Char8 as BS
import Network
import System.IO
+import Control.Monad
+import Control.Concurrent
import Network.YAML.Base
import Network.YAML.Instances
@@ -43,3 +45,29 @@ callDynamic getServer service name args = do
srv <- getServer service
call srv name args
+-- | Call a method and put it's result into MVar
+callF :: (IsYamlObject a, IsYamlObject b)
+ => (BS.ByteString -> IO (BS.ByteString, Int)) -- ^ Get (Host, port) from service name
+ -> BS.ByteString -- ^ Service name
+ -> BS.ByteString -- ^ Method name
+ -> (a, MVar b) -- ^ (Argument, MVar for result)
+ -> IO ()
+callF getServer service name (args, var) = do
+ srv <- getServer service
+ r <- call srv name args
+ putMVar var r
+
+-- | Call a method for each argument in the list in parallel
+-- (it can run method for each argument on another server)
+callP :: (IsYamlObject a, IsYamlObject b)
+ => (BS.ByteString -> IO (BS.ByteString, Int)) -- ^ Get (Host, port) from service name
+ -> BS.ByteString -- ^ Service name
+ -> BS.ByteString -- ^ Method name
+ -> [a] -- ^ List of arguments
+ -> IO [b]
+callP getServer service name args = do
+ let n = length args
+ vars <- replicateM n newEmptyMVar
+ mapM (forkIO . callF getServer service name) $ zip args vars
+ mapM takeMVar vars
+
diff --git a/Network/YAML/Derive.hs b/Network/YAML/Derive.hs
index 44dfbda..1c5c6cd 100644
--- a/Network/YAML/Derive.hs
+++ b/Network/YAML/Derive.hs
@@ -13,7 +13,6 @@ import Data.Object.Yaml
import qualified Data.ByteString.Char8 as BS
import Network.YAML.Base
-import Network.YAML.Instances
mkList :: [Name] -> ExpQ
mkList [] = [| [] |]
diff --git a/Test.hs b/Test.hs
index 4e76087..4ce1668 100644
--- a/Test.hs
+++ b/Test.hs
@@ -13,7 +13,11 @@ import TestTypes
double :: Point -> IO Point
double (Point x y) = return $ Point (x*2) (y*2)
-rules = mkRules [("double", yamlMethod double)]
+mySum :: [Double] -> IO Double
+mySum = return . sum
+
+rules = mkRules [("double", yamlMethod double),
+ ("sum", yamlMethod mySum)]
main = do
putStrLn "Listening..."
diff --git a/TestCall.hs b/TestCall.hs
index 1c3670b..380243a 100644
--- a/TestCall.hs
+++ b/TestCall.hs
@@ -14,7 +14,13 @@ getService _ = fail "Unknown service"
p = Point 2.0 3.0
+ps = [Point 3.0 5.0, Point 1.0 2.1, Point 0.1 0.2]
+
main = do
srv <- getService "test"
r <- call srv "double" p
print (r :: Point)
+ s <- call srv "sum" ([3.5, 5.5, 1.0] :: [Double])
+ print (s :: Double)
+ rs <- callP getService "test" "double" ps
+ print (rs :: [Point])