Changeset 8587

Timestamp:

01/05/06 23:48:09 (3 years ago)

Author:

gaal

Message:

Data.Yaml.Syck: broken support for hash emitting; thinks hashes are
lists of pairs.
Lots of trace prints left in the code till I figure this out.

Location:

src

Files:

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

src/Data/Yaml/Syck.hsc

@@ -103 +103 @@
             withCString "array" $ \array_literal ->
                 syck_emit_seq e array_literal seqNone
+            -- TODO: fix pesky warning about "integer from pointer without a cast" here
             mapM_ (syck_emit_item e) =<< (mapM freezeNode seq)
             syck_emit_end e
         (YamlMap m) -> do
-            error "not yet"
             -- syck_emit_map(e, "hash", map_none);
+            trace ("a hash: " ++ (show m)) $ return ()
             withCString "hash" $ \hash_literal ->
                 syck_emit_map e hash_literal mapNone
+            mapM_ (\(k,v) -> (syck_emit_item e =<< freezeNode k) >> (syck_emit_item e =<< freezeNode v)) m
+            syck_emit_end e
 
 

src/Pugs/Prim/Yaml.hs

@@ -49 +49 @@
 --toYaml (VNum num) = return $ YamlStr -- better handled by pretty?
 toYaml _ (VStr str) = return $ YamlStr (encodeUTF8 str)
-toYaml (d+1) (VList nodes) = do
-    fmap YamlSeq $ mapM (toYaml d) nodes
 toYaml (d+1) v@(VRef r) = do  -- stolen from Pugs.Prim prettyVal. Can these be refactored together?
     v'  <- readRef r
-    ifValTypeIsa v "Pair"
-        (case v' of
-            VList [ks, vs] -> do
-                kStr <- toYaml d ks
-                vStr <- toYaml d vs
-                return $ YamlMap [(kStr, vStr)] -- assume a pair is a one-element hash
-            _ -> toYaml d v'                    -- XXX: probably broken to blithingly ignore ref levels here
+    t <- evalValType v
+    trace ("toYaml VRef: " ++ (show v) ++ " type=" ++ (show t)) $ return ()
+    (ifValTypeIsa v "Hash"
+        (do 
+            case r of
+                MkRef (IHash hv) -> do
+                    h <- hash_fetch hv
+                    let assocs = Map.toList h
+                    yamlmap <- mapM ( \(k, v) -> do
+                        k' <- toYaml d (VStr k)
+                        v' <- toYaml d v
+                        return (k', v')) assocs
+                    return $ YamlMap yamlmap
+                _ -> error ("can't process hash: " ++ show v') -- XXX
         )
         (do nodes <- toYaml d v'
             ifValTypeIsa v "Array"
                 (return $ nodes)
-                (ifValTypeIsa v "Hash"
-                    --(return $ YamlMap('{':(init (tail str))) ++ "}")
-                    (return nodes)
-                    (return $ YamlMap [(YamlStr "<ref>", nodes)])) -- XXX
+                (return $ YamlMap [(YamlStr "<ref>", nodes)])) -- XXX
         )
+toYaml (d+1) (VList nodes) = do
+    trace ("toYaml VList: " ++ (show nodes)) $ return ()
+    fmap YamlSeq $ mapM (toYaml d) nodes
 toYaml _ v = return $ YamlStr $ encodeUTF8 $ pretty v
 
 
-    
+   
+{-
+ifValTypeIsa v "Pair"
+    (case v' of
+        VList [ks, vs] -> do
+            kStr <- toYaml d ks
+            vStr <- toYaml d vs
+            return $ YamlMap [(kStr, vStr)] -- assume a pair is a one-element hash
+        _ -> toYaml d v'                    -- XXX: probably broken to blithingly ignore ref levels here
+    )
+    (ifValTypeIsa v "Hash"
+        --fmap YamlMap $ mapM (\(k, v) -> do {k' <- toYaml k; v' <- toYaml v; return (k', v')}) Map.toList =<< hash_fetch v')
+        (do 
+            case r of
+                MkRef (IHash hv) -> do
+                    h <- hash_fetch hv
+                    let assocs = Map.toList h
+                    yamlmap <- mapM (\(k, v) -> do
+                        k' <- toYaml d (VStr k)
+                        v' <- toYaml d v
+                        return (k', v')) assocs
+                    return $ YamlMap yamlmap
+                _ -> error ("can't process hash: " ++ show v') -- XXX
+        )
+        (do nodes <- toYaml d v'
+            ifValTypeIsa v "Array"
+                (return $ nodes)
+                (return $ YamlMap [(YamlStr "<ref>", nodes)])) -- XXX
+    )
+-}