Tests, fixes.

Ilya Portnov [2010-04-24 06:03:24]
Tests, fixes.
Filename
Methods.hs
Network/YAML/Instances.hs
Network/YAML/Server.hs
Test.hs
TestCall.hs
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
ViewGit