instance IsYamlObject (a,b)

Ilya Portnov [2010-04-23 13:09:44]
instance IsYamlObject (a,b)
Filename
Network/YAML/Instances.hs
Test.hs
TestCall.hs
diff --git a/Network/YAML/Instances.hs b/Network/YAML/Instances.hs
index 8a563f2..66df8e8 100644
--- a/Network/YAML/Instances.hs
+++ b/Network/YAML/Instances.hs
@@ -31,6 +31,25 @@ instance (IsYamlObject a) => ConvertSuccess YamlObject [a] where

 instance (IsYamlObject a) => IsYamlObject [a] where

+instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess (a,b) YamlObject where
+  convertSuccess (x,y) = Sequence [cs x, cs y]
+
+instance (IsYamlObject a, IsYamlObject b) => ConvertSuccess YamlObject (a,b) where
+  convertSuccess obj = (cs x, cs y)
+    where
+      tryGet lst k =
+        if k >= length lst
+          then def
+          else lst !! k
+      list = getList obj
+      x = tryGet list 0
+      y = tryGet list 1
+
+instance (IsYamlObject a, IsYamlObject b) => IsYamlObject (a,b) where
+
+instance (Default a, Default b) => Default (a,b) where
+  def = (def, def)
+
 instance Default YamlObject where
   def = Sequence []

diff --git a/Test.hs b/Test.hs
index 35cd10a..ad62097 100644
--- a/Test.hs
+++ b/Test.hs
@@ -18,14 +18,14 @@ double (Point x y) = return $ Point (x*2) (y*2)
 mySum :: [Double] -> IO Double
 mySum = return . sum

-counter :: Int -> IO Int
-counter k = do
+counter :: (Int,Int) -> IO Int
+counter (k,d) = do
     mapM count [k..k+10]
     return (k+10)
   where
     count i = do
-      print i
-      threadDelay 1000000
+      putStrLn $ show d ++ ": " ++ show i
+      threadDelay (d*100000)

 rules = mkRules [("double", yamlMethod double),
                  ("sum",    yamlMethod mySum),
diff --git a/TestCall.hs b/TestCall.hs
index 5a1a1fb..e5448a5 100644
--- a/TestCall.hs
+++ b/TestCall.hs
@@ -28,5 +28,5 @@ main = do
   print (s :: Double)
   rs <- callP getService "test" "double" ps
   print (rs :: [Point])
-  cs <- callP getService "test" "count" ([3,4,5,6] :: [Int])
+  cs <- callP getService "test" "count" $ zip ([3,4,5,6] :: [Int]) ([1..] :: [Int])
   print (cs :: [Int])
ViewGit