Changeset 8606 for src/Pugs/Prim/Yaml.hs

Show
Ignore:
Timestamp:
01/07/06 13:49:41 (3 years ago)
Author:
gaal
Message:

.yaml:

  • make YamlNode? resemble SyckNode? a little better in structure. This will come useful when eventually we need to serialize "undef but" etc.
  • golfage (I hope it's sane, or in the right form of insanity at least)
Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim/Yaml.hs

    r8604 r8606  
    2323 
    2424fromYaml :: YamlNode -> Eval Val 
    25 fromYaml YamlNil = return VUndef 
    26 fromYaml (YamlStr str) = return $ VStr (decodeUTF8 str) 
    27 fromYaml (YamlSeq nodes) = do 
     25fromYaml MkYamlNode{el=YamlNil}      = return VUndef 
     26fromYaml MkYamlNode{el=YamlStr str}  = return $ VStr (decodeUTF8 str) 
     27fromYaml MkYamlNode{el=YamlSeq nodes} = do 
    2828    vals    <- mapM fromYaml nodes 
    2929    av      <- liftSTM $ newTVar $ 
    3030        IntMap.fromAscList ([0..] `zip` map lazyScalar vals) 
    3131    return $ VRef (arrayRef av) 
    32 fromYaml (YamlMap _ nodes) = do 
     32fromYaml MkYamlNode{el=YamlMap nodes} = do 
    3333    vals    <- forM nodes $ \(keyNode, valNode) -> do 
    3434        key <- fromVal =<< fromYaml keyNode 
    … …  
    4747 
    4848toYaml :: (?d :: Int) => Val -> Eval YamlNode 
    49 toYaml _ | ?d == 0  = return $ YamlStr "<deep recursion>" -- fail? make this configurable? 
    50 toYaml VUndef       = return YamlNil 
    51 toYaml (VStr str)   = return $ YamlStr (encodeUTF8 str) 
     49toYaml _ | ?d == 0  = return $ emptyYamlNode{el = YamlStr "<deep recursion>"} -- fail? make this configurable? 
     50toYaml VUndef       = return emptyYamlNode 
     51toYaml (VStr str)   = return $ emptyYamlNode{el = YamlStr (encodeUTF8 str)} 
    5252toYaml v@(VRef r)   = let ?d = pred ?d in do 
    5353    t  <- evalValType v 
    … …  
    5757        ifValTypeIsa v "Array" (return nodes) $ case v' of 
    5858            VObject _   -> return nodes 
    59             _           -> return (YamlMap Nothing [(YamlStr "<ref>", nodes)]) 
     59            _           -> return emptyYamlNode{el = YamlMap [(emptyYamlNode{el=YamlStr "<ref>"}, nodes)]} 
    6060toYaml (VList nodes) = let ?d = pred ?d in do 
    61     fmap YamlSeq $ mapM toYaml nodes 
     61    n <- mapM toYaml nodes 
     62    return $ emptyYamlNode{el=YamlSeq n} -- golfme! 
     63    -- fmap YamlSeq$ mapM toYaml nodes 
    6264toYaml v@(VObject obj) = let ?d = pred ?d in do 
    6365    -- ... dump the objAttrs 
    … …  
    6769    hash    <- fromVal v :: Eval VHash 
    6870    attrs   <- toYaml $ VRef (hashRef hash) 
    69     return $ addTag (Just $ "tag:pugs:object:" ++ showType (objType obj)) attrs 
    70     where 
    71     addTag _   (YamlMap (Just x) _) = error ("can't add tag: already tagged with" ++ x) 
    72     addTag tag (YamlMap _        m) = YamlMap tag m 
    73 toYaml v = (return . YamlStr . encodeUTF8 . pretty) v 
     71    return $ tagNode (Just $ "tag:pugs:object:" ++ showType (objType obj)) attrs 
     72toYaml v = return $ emptyYamlNode{el=YamlStr p} 
     73    where p = (encodeUTF8 . pretty) v 
     74 
    7475 
    7576hashToYaml :: (?d :: Int) => VRef -> Eval YamlNode 
    … …  
    8182        va' <- toYaml va 
    8283        return (ka', va') 
    83     return $ YamlMap Nothing yamlmap 
     84    return $ emptyYamlNode{el=YamlMap yamlmap} 
    8485hashToYaml r = error ("unexpected node: " ++ show r) 
    85     
    86 {- 
    87 ifValTypeIsa v "Pair" 
    88     (case v' of 
    89         VList [ks, vs] -> do 
    90             kStr <- toYaml d ks 
    91             vStr <- toYaml d vs 
    92             return $ YamlMap [(kStr, vStr)] -- assume a pair is a one-element hash 
    93         _ -> toYaml d v'                    -- XXX: probably broken to blithingly ignore ref levels here 
    94     ) 
    95     (ifValTypeIsa v "Hash" 
    96         --fmap YamlMap $ mapM (\(k, v) -> do {k' <- toYaml k; v' <- toYaml v; return (k', v')}) Map.toList =<< hash_fetch v') 
    97         (do  
    98             case r of 
    99                 MkRef (IHash hv) -> do 
    100                     h <- hash_fetch hv 
    101                     let assocs = Map.toList h 
    102                     yamlmap <- mapM (\(k, v) -> do 
    103                         k' <- toYaml d (VStr k) 
    104                         v' <- toYaml d v 
    105                         return (k', v')) assocs 
    106                     return $ YamlMap yamlmap 
    107                 _ -> error ("can't process hash: " ++ show v') -- XXX 
    108         ) 
    109         (do nodes <- toYaml d v' 
    110             ifValTypeIsa v "Array" 
    111                 (return $ nodes) 
    112                 (return $ YamlMap [(YamlStr "<ref>", nodes)])) -- XXX 
    113     ) 
    114 -} 
     86