Changeset 8608
- Timestamp:
- 01/08/06 20:40:46 (3 years ago)
- Location:
- src
- Files:
-
- 2 modified
-
Data/Yaml/Syck.hsc (modified) (5 diffs)
-
Pugs/Prim/Yaml.hs (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/Data/Yaml/Syck.hsc
r8607 r8608 31 31 32 32 data YamlNode = MkYamlNode 33 { nid :: SYMID 34 , tag :: YamlTag 35 , anchor :: YamlAnchor 36 , el :: YamlElem 33 { nid :: SYMID 34 , el :: YamlElem 35 , tag :: YamlTag 36 , anchor :: YamlAnchor 37 , shortcut :: (Maybe YamlNode) 37 38 } 38 39 deriving (Show, Ord, Eq) … … 58 59 59 60 emptyYamlNode :: YamlNode 60 emptyYamlNode = MkYamlNode 0 Nothing Nothing YamlNil61 emptyYamlNode = MkYamlNode 0 YamlNil Nothing Nothing Nothing 61 62 62 63 tagNode :: YamlTag -> YamlNode -> YamlNode … … 64 65 tagNode tag node = node{tag = tag} 65 66 66 -- the extra comma here isnot a bug67 -- the extra commas here are not a bug 67 68 #enum CInt, , scalar_none, scalar_1quote, scalar_2quote, scalar_fold, scalar_literal, scalar_plain 68 69 #enum CInt, , seq_none, seq_inline … … 105 106 106 107 emitterCallback :: SyckEmitter -> Ptr () -> IO () 107 emitterCallback e vp = let ?e = e in emitNode =<< thawNode vp108 emitterCallback e vp = emitNode e =<< thawNode vp 108 109 109 emitNode :: (?e :: SyckEmitter)-> YamlNode -> IO ()110 emitNode n@(MkYamlNode{el = YamlNil}) = do110 emitNode :: SyckEmitter -> YamlNode -> IO () 111 emitNode e n@(MkYamlNode{el = YamlNil}) = do 111 112 withTag n "string" $ \tag -> 112 113 withCString "~" $ \cs -> 113 syck_emit_scalar ?e tag scalarNone 0 0 0 cs 1114 115 emitNode n@(MkYamlNode{el = YamlStr str}) = do114 syck_emit_scalar e tag scalarNone 0 0 0 cs 1 115 116 emitNode e n@(MkYamlNode{el = YamlStr str}) = do 116 117 withTag n "string" $ \tag -> 117 118 withCString str $ \cs -> 118 syck_emit_scalar ?e tag scalarNone 0 0 0 cs (toEnum $ length str)119 120 emitNode n@(MkYamlNode{el = YamlSeq seq}) = do119 syck_emit_scalar e tag scalarNone 0 0 0 cs (toEnum $ length str) 120 121 emitNode e n@(MkYamlNode{el = YamlSeq seq}) = do 121 122 withTag n "array" $ \tag -> 122 syck_emit_seq ?e tag seqNone123 syck_emit_seq e tag seqNone 123 124 -- TODO: fix pesky warning about "integer from pointer without a cast" here 124 mapM_ (syck_emit_item ?e) =<< (mapM freezeNode seq) 125 syck_emit_end ?e 126 127 emitNode n@(MkYamlNode{el = YamlMap m}) = do 128 --trace ("hash<" ++ maybe "" id tag ++">: " ++ (show m)) $ return () 125 mapM_ (syck_emit_item e) =<< (mapM freezeNode seq) 126 syck_emit_end e 127 128 emitNode e n@(MkYamlNode{el = YamlMap m}) = do 129 129 withTag n "hash" $ \tag -> 130 syck_emit_map ?e tag mapNone130 syck_emit_map e tag mapNone 131 131 flip mapM_ m (\(k,v) -> do 132 syck_emit_item ?e =<< freezeNode k133 syck_emit_item ?e =<< freezeNode v)134 syck_emit_end ?e132 syck_emit_item e =<< freezeNode k 133 syck_emit_item e =<< freezeNode v) 134 syck_emit_end e 135 135 136 136 withTag :: YamlNode -> String -> (CString -> IO a) -> IO a … … 146 146 syck_parser_implicit_typing parser 1 147 147 syck_parser_taguri_expansion parser 0 148 symId 148 symId <- syck_parse parser 149 149 if symId /= 0 then fmap (Right . Just) (readNode parser symId) else do 150 150 rv <- readIORef err -
src/Pugs/Prim/Yaml.hs
r8607 r8608 54 54 (return . VStr) rv 55 55 56 strNode :: String -> YamlNode 57 strNode str = emptyYamlNode{el = YamlStr str } 58 56 59 toYaml :: (?d :: Int) => Val -> Eval YamlNode 57 toYaml _ | ?d == 0 = return $ emptyYamlNode{el = YamlStr "<deep recursion>"}-- fail? make this configurable?60 toYaml _ | ?d == 0 = return $ strNode "<deep recursion>" -- fail? make this configurable? 58 61 toYaml VUndef = return emptyYamlNode 59 toYaml (VStr str) = return $ emptyYamlNode{el = YamlStr (encodeUTF8 str)} 62 toYaml (VBool x) = return $ boolToYaml x 63 toYaml (VStr str) = return $ strNode (encodeUTF8 str) 60 64 toYaml v@(VRef r) = let ?d = pred ?d in do 61 65 t <- evalValType v … … 65 69 ifValTypeIsa v "Array" (return nodes) $ case v' of 66 70 VObject _ -> return nodes 67 _ -> return emptyYamlNode{el = YamlMap [( emptyYamlNode{el=YamlStr "<ref>"}, nodes)]}71 _ -> return emptyYamlNode{el = YamlMap [(strNode "<ref>", nodes)]} 68 72 toYaml (VList nodes) = let ?d = pred ?d in do 69 73 n <- mapM toYaml nodes … … 78 82 attrs <- toYaml $ VRef (hashRef hash) 79 83 return $ tagNode (Just $ "tag:pugs:object:" ++ showType (objType obj)) attrs 80 toYaml v = return $ emptyYamlNode{el=YamlStr p} 81 where p = (encodeUTF8 . pretty) v 84 toYaml (VRule MkRulePGE{rxRule=rule, rxGlobal=global, rxStringify=stringify, rxAdverbs=adverbs}) = let ?d = pred ?d in do 85 adverbs' <- toYaml adverbs 86 return emptyYamlNode{el = YamlMap 87 [ (strNode "rule", strNode rule) 88 , (strNode "global", boolToYaml global) 89 , (strNode "stringify", boolToYaml stringify) 90 , (strNode "adverbs", adverbs') 91 ] , tag = Just "tag:pugs:Rule"} 92 toYaml v = return $ strNode $ (encodeUTF8 . pretty) v 82 93 83 94 … … 93 104 hashToYaml r = error ("unexpected node: " ++ show r) 94 105 106 boolToYaml :: VBool -> YamlNode 107 boolToYaml True = strNode "true" 108 boolToYaml False = strNode "false"
