Changeset 8607

Timestamp:

01/08/06 15:26:21 (3 years ago)

Author:

gaal

Message:

* eval :lang<yaml> deserializes pugs objects.

Location:

src

Files:

• Data/Yaml/Syck.hsc (modified) (3 diffs)
• Pugs/Prim/Yaml.hs (modified) (1 diff)

src/Data/Yaml/Syck.hsc

@@ -193 +193 @@
     deRefStablePtr (castPtrToStablePtr ptr)
 
+syckNodeTag :: SyckNode -> IO (Maybe String)
+syckNodeTag syckNode = do
+    tag <- #{peek SyckNode, type_id} syckNode
+    if (tag == nullPtr) then (return Nothing) else do
+        tag' <- peekCString tag
+        return $ Just tag'
+
 syckNodeKind :: SyckNode -> IO SyckKind
 syckNodeKind syckNode = fmap toEnum $ #{peek SyckNode, kind} syckNode
@@ -203 +210 @@
 parseNode :: SyckKind -> SyckParser -> SyckNode -> CLong -> IO YamlNode
 parseNode SyckMap parser syckNode len = do
+    tag   <- syckNodeTag syckNode
     pairs <- (`mapM` [0..len-1]) $ \idx -> do
         keyId   <- syck_map_read syckNode 0 idx
@@ -209 +217 @@
         val     <- readNode parser valId
         return (key, val)
-    return $ emptyYamlNode{ el = YamlMap pairs }
+    return $ emptyYamlNode{ el = YamlMap pairs, tag = tag}
 
 parseNode SyckSeq parser syckNode len = do
+    tag   <- syckNodeTag syckNode
     nodes <- (`mapM` [0..len-1]) $ \idx -> do
         symId   <- syck_seq_read syckNode idx
         readNode parser symId
-    return $ emptyYamlNode{ el = YamlSeq nodes }
+    return $ emptyYamlNode{ el = YamlSeq nodes, tag = tag }
 
 parseNode SyckStr _ syckNode len = do
-    cstr    <- syck_str_read syckNode
-    str     <- peekCStringLen (cstr, fromEnum len)
-    return $ emptyYamlNode{ el = YamlStr str }
+    tag   <- syckNodeTag syckNode
+    cstr  <- syck_str_read syckNode
+    str   <- peekCStringLen (cstr, fromEnum len)
+    return $ emptyYamlNode{ el = YamlStr str, tag = tag }
 
 foreign import ccall "wrapper"  

src/Pugs/Prim/Yaml.hs

@@ -30 +30 @@
         IntMap.fromAscList ([0..] `zip` map lazyScalar vals)
     return $ VRef (arrayRef av)
-fromYaml MkYamlNode{el=YamlMap nodes} = do
-    vals    <- forM nodes $ \(keyNode, valNode) -> do
-        key <- fromVal =<< fromYaml keyNode
-        val <- newScalar =<< fromYaml valNode
-        return (key, val)
-    hv      <- liftSTM $ (newTVar (Map.fromList vals) :: STM IHash)
-    -- XXX: if YamlMap (Just "!perl/":type) nodes then mkObject etc.
-    return $ VRef (hashRef hv)
+fromYaml MkYamlNode{el=YamlMap nodes,tag=tag} = do
+    case tag of
+        Nothing  -> do
+            vals    <- forM nodes $ \(keyNode, valNode) -> do
+                key <- fromVal =<< fromYaml keyNode
+                val <- newScalar =<< fromYaml valNode
+                return (key, val)
+            hv      <- liftSTM $ (newTVar (Map.fromList vals) :: STM IHash)
+            return $ VRef (hashRef hv)
+        Just ('p':'u':'g':'s':'/':'o':'b':'j':'e':'c':'t':':':typ) -> do
+            vals    <- forM nodes $ \(keyNode, valNode) -> do
+                key <- fromVal =<< fromYaml keyNode
+                val <- fromYaml valNode
+                return (key, val)
+            return . VObject =<< createObject (mkType typ) vals
+        Just x   -> error ("can't deserialize: " ++ x)
 
 dumpYaml :: Int -> Val -> Eval Val