diff --git a/Methods.hs b/Methods.hs index 608c8c1..b2bf692 100644 --- a/Methods.hs +++ b/Methods.hs @@ -1,7 +1,11 @@ -- | Testing RPC methods are defined here +-- These functions will be run only in `server' (Test.hs), `client' +-- (TestCall.hs) uses only their names and types. module Methods where import Control.Concurrent +import System.Directory +import Codec.Binary.UTF8.String import TestTypes @@ -20,3 +24,9 @@ counter (k,d) = do putStrLn $ show d ++ ": " ++ show i threadDelay (d*100000) +ls :: String -> IO [String] +ls path = do + let path' = encodeString path + lst <- getDirectoryContents path' + return $ map decodeString lst + diff --git a/Network/YAML/Instances.hs b/Network/YAML/Instances.hs index 66df8e8..040d1a2 100644 --- a/Network/YAML/Instances.hs +++ b/Network/YAML/Instances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, OverloadedStrings, FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, OverloadedStrings, FlexibleInstances, IncoherentInstances #-} module Network.YAML.Instances where @@ -79,6 +79,14 @@ instance ConvertSuccess BS.ByteString YamlObject where instance IsYamlObject BS.ByteString where +instance ConvertSuccess YamlObject String where + convertSuccess x = fromMaybe def $ getScalar x + +instance ConvertSuccess String YamlObject where + convertSuccess x = Scalar $ toYamlScalar x + +instance IsYamlObject String where + data Call = Call { methodName :: BS.ByteString, args :: YamlObject } deriving (Show) diff --git a/Network/YAML/Server.hs b/Network/YAML/Server.hs index 6240f0c..7978ba1 100644 --- a/Network/YAML/Server.hs +++ b/Network/YAML/Server.hs @@ -62,7 +62,7 @@ server port callOut = do case unserialize text of Nothing -> hClose h Just ob -> do - print ob +-- print ob res <- callOut ob BS.hPutStrLn h $ serialize res hClose h) diff --git a/Test.hs b/Test.hs index b1405da..473972c 100644 --- a/Test.hs +++ b/Test.hs @@ -16,7 +16,7 @@ import TestTypes import Methods -- Declare dispatchingRules for given functions -$(declareRules ['double, 'mySum, 'counter]) +$(declareRules ['double, 'mySum, 'counter, 'ls]) main = do putStrLn "Listening..." diff --git a/TestCall.hs b/TestCall.hs index c865b0b..ad88052 100644 --- a/TestCall.hs +++ b/TestCall.hs @@ -14,9 +14,10 @@ import Network.YAML.WrapMethods import TestTypes import qualified Methods --- declare `double' and `mySum' as RPC methods +-- declare `double', `mySum' and `ls' as RPC methods $(remote 'Methods.double) $(remote 'Methods.mySum) +$(remote 'Methods.ls) rules = [("test", ("127.0.0.1", 5000), 1), ("test", ("127.0.0.1", 5001), 1), @@ -29,13 +30,15 @@ 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" + test <- getService "test" -- call remote functions - r <- double srv p + r <- double test p print r - s <- mySum srv [3.5, 5.5, 1.0] + s <- mySum test [3.5, 5.5, 1.0] print s + lst <- ls test "/tmp" + print lst -- call remote functions for many arguments, for each argument on different server maybe rs <- callP getService "test" "double" ps