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

Show
Ignore:
Timestamp:
01/07/06 10:10:58 (3 years ago)
Author:
audreyt
Message:

* Pugs.Prim.Yaml: Slight refactoring.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim/Yaml.hs

    r8600 r8601  
    4848 
    4949toYaml :: Int -> Val -> Eval YamlNode 
    50 toYaml 0 _ = return $ YamlStr "<deep recursion>" -- fail? make this configurable? 
    51 toYaml _ VUndef = return YamlNil 
    52 --toYaml (VNum num) = return $ YamlStr -- better handled by pretty? 
    53 toYaml _ (VStr str) = return $ YamlStr (encodeUTF8 str) 
    54 toYaml (d+1) v@(VRef r) = do  -- stolen from Pugs.Prim prettyVal. Can these be refactored together? 
    55     v'  <- readRef r 
    56     t <- evalValType v 
    57     trace ("toYaml VRef: " ++ (show v) ++ " type=" ++ (show t)) $ return () 
    58     (ifValTypeIsa v "Hash" 
    59         (case r of 
    60             -- "My brain just exploded. I can't handle pattern bindings for existentially-quantified constructors." 
    61             -- let (MkRef (IHash hv)) = r 
    62             -- XXX golfme for readability! 
    63             MkRef (IHash hv) -> do 
    64                 h <- hash_fetch hv 
    65                 let assocs = Map.toList h 
    66                 yamlmap <- flip mapM assocs (\(ka, va) -> do 
    67                    ka' <- toYaml d (VStr ka) 
    68                    va' <- toYaml d va 
    69                    return (ka', va')) 
    70                 return $ YamlMap Nothing yamlmap 
    71             _ -> error ("unexpected node: " ++ show v) 
    72         ) 
    73         (do nodes <- toYaml d v' 
    74             (ifValTypeIsa v "Array" 
    75                 (return $ nodes) --(return $ YamlMap Nothing [(YamlStr "<ref>", nodes)])) -- XXX 
    76                 (return $ case v' of 
    77                     VObject _ -> nodes 
    78                     _ -> YamlMap Nothing [(YamlStr "<ref>", nodes)] -- XXX 
    79                 )))) 
     50toYaml 0     _          = return $ YamlStr "<deep recursion>" -- fail? make this configurable? 
     51toYaml _     VUndef     = return YamlNil 
     52toYaml _     (VStr str) = return $ YamlStr (encodeUTF8 str) 
     53toYaml (d+1) v@(VRef r) = do 
     54    t  <- evalValType v 
     55    ifValTypeIsa v "Hash" (hashToYaml d r) $ do 
     56        v'      <- readRef r 
     57        nodes   <- toYaml d v' 
     58        ifValTypeIsa v "Array" (return nodes) $ case v' of 
     59            VObject _   -> return nodes 
     60            _           -> return (YamlMap Nothing [(YamlStr "<ref>", nodes)]) 
    8061toYaml (d+1) (VList nodes) = do 
    81     trace ("toYaml VList: " ++ (show nodes)) $ return () 
    8262    fmap YamlSeq $ mapM (toYaml d) nodes 
    8363toYaml (d+1) v@(VObject obj) = do 
    … …  
    9070    return $ addTag (Just $ "!pugs:object/" ++ showType (objType obj)) attrs 
    9171    where 
    92         addTag _ (YamlMap (Just x) _) = error ("can't add tag: already tagged with" ++ x) 
    93         addTag tag (YamlMap _ m) = YamlMap tag m 
     72    addTag _ (YamlMap (Just x) _) = error ("can't add tag: already tagged with" ++ x) 
     73    addTag tag (YamlMap _ m) = YamlMap tag m 
    9474toYaml _ v = return $ YamlStr $ encodeUTF8 $ pretty v 
    9575 
    96  
     76hashToYaml :: Int -> VRef -> Eval YamlNode 
     77hashToYaml d (MkRef (IHash hv)) = do 
     78    h <- hash_fetch hv 
     79    let assocs = Map.toList h 
     80    yamlmap <- flip mapM assocs (\(ka, va) -> do 
     81        ka' <- toYaml d (VStr ka) 
     82        va' <- toYaml d va 
     83        return (ka', va')) 
     84    return $ YamlMap Nothing yamlmap 
     85hashToYaml _ r = error ("unexpected node: " ++ show r) 
    9786    
    9887{-