module Network.YAML.Caller where
import qualified Data.Map as M
import Data.Object.Yaml
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
import Network.YAML.Server
sendYAML :: (BS.ByteString, Int)
-> BS.ByteString
-> IO BS.ByteString
sendYAML (host,port) yaml = withSocketsDo $ do
h <- connectTo (BS.unpack host) (PortNumber $ fromIntegral port)
hSetBuffering h NoBuffering
BS.hPutStrLn h yaml
lns <- readHandle h []
hClose h
let text = BS.unlines lns
return text
call :: (IsYamlObject a, IsYamlObject b)
=> (BS.ByteString, Int)
-> BS.ByteString
-> a
-> IO b
call (host,port) name args = do
let c = mkCall name (cs args)
s = serialize c
text <- sendYAML (host,port) s
case unserialize text of
Nothing -> fail "No answer"
Just x -> return x
callDynamic :: (IsYamlObject a, IsYamlObject b)
=> (BS.ByteString -> IO (BS.ByteString,Int))
-> BS.ByteString
-> BS.ByteString
-> a
-> IO b
callDynamic getServer service name args = do
srv <- getServer service
call srv name args
callF :: (IsYamlObject a, IsYamlObject b)
=> (BS.ByteString -> IO (BS.ByteString, Int))
-> BS.ByteString
-> BS.ByteString
-> (a, MVar b)
-> IO ()
callF getServer service name (args, var) = do
srv <- getServer service
r <- call srv name args
putMVar var r
callP :: (IsYamlObject a, IsYamlObject b)
=> (BS.ByteString -> IO (BS.ByteString, Int))
-> BS.ByteString
-> BS.ByteString
-> [a]
-> 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