Changeset 8586

Show
Ignore:
Timestamp:
01/05/06 20:28:39 (3 years ago)
Author:
gaal
Message:

Data.Yaml.Syck:

  • emitting arrays
  • unbreak eval :lang<yaml>
Location:
src
Files:
3 modified

Legend:

Unmodified
Added
Removed

  • src/Data/Yaml/Syck.hsc

    r8585 r8586  
    4646-- the extra comma here is not a bug 
    4747#enum CInt, , scalar_none, scalar_1quote, scalar_2quote, scalar_fold, scalar_literal, scalar_plain 
     48#enum CInt, , seq_none, seq_inline 
     49#enum CInt, , map_none, map_inline 
    4850 
    4951#def typedef void* EmitterExtras; 
    … …  
    8890    case node of 
    8991        YamlNil -> do 
    90             -- return syck_emit_scalar(e, "string", scalar_none, 0, 0, 0, "~", 1); 
     92            -- syck_emit_scalar(e, "string", scalar_none, 0, 0, 0, "~", 1); 
    9193            withCString "string" $ \string_literal ->        
    9294                withCString "~" $ \cs ->        
    … …  
    9799                withCString str $ \cs ->        
    98100                    syck_emit_scalar e string_literal scalarNone 0 0 0 cs (toEnum $ length str) 
     101        (YamlSeq seq) -> do 
     102            -- syck_emit_seq(e, "array", seq_none); 
     103            withCString "array" $ \array_literal -> 
     104                syck_emit_seq e array_literal seqNone 
     105            mapM_ (syck_emit_item e) =<< (mapM freezeNode seq) 
     106            syck_emit_end e 
     107        (YamlMap m) -> do 
     108            error "not yet" 
     109            -- syck_emit_map(e, "hash", map_none); 
     110            withCString "hash" $ \hash_literal -> 
     111                syck_emit_map e hash_literal mapNone 
     112 
    99113 
    100114parseYaml :: String -> IO (Either String (Maybe YamlNode)) 
    … …  
    119133    len     <- syckNodeLength kind syckNode 
    120134    node    <- parseNode kind parser syckNode len 
    121     nodePtr <- freezeNode node 
     135    nodePtr <- writeNode node 
    122136    symId   <- syck_add_sym parser nodePtr 
    123137    return (toEnum . fromEnum $ symId) 
    … …  
    135149        ] 
    136150 
    137 --freezeNode :: YamlNode -> IO SyckNodePtr 
     151freezeNode :: YamlNode -> IO (Ptr a) 
    138152freezeNode node = do 
    139153    ptr     <- newStablePtr node 
    … …  
    142156thawNode :: Ptr () -> IO YamlNode 
    143157thawNode nodePtr = deRefStablePtr (castPtrToStablePtr nodePtr) 
     158 
     159writeNode :: YamlNode -> IO SyckNodePtr 
     160writeNode node = do 
     161    ptr     <- newStablePtr node 
     162    new (castPtr $ castStablePtrToPtr ptr) 
    144163 
    145164readNode :: SyckParser -> SYMID -> IO YamlNode 
    … …  
    250269    syck_emit_scalar :: SyckEmitter -> CString -> CInt -> CInt -> CInt -> CInt -> CString -> CInt -> IO () 
    251270 
     271foreign import ccall 
     272    syck_emit_seq :: SyckEmitter -> CString -> CInt -> IO () 
     273 
     274foreign import ccall 
     275    syck_emit_item :: SyckEmitter -> SyckNodePtr -> IO () 
     276 
     277foreign import ccall 
     278    syck_emit_end :: SyckEmitter -> IO () 
     279 
     280foreign import ccall 
     281    syck_emit_map :: SyckEmitter -> CString -> CInt -> IO () 
     282 

  • src/Pugs/Prim.hs

    r8566 r8586  
    223223op1 "none" = op1Cast opJuncNone 
    224224op1 "perl" = fmap VStr . prettyVal 0 
    225 op1 "yaml" = dumpYaml 
     225op1 "yaml" = dumpYaml 1024 -- number == max recursion depth 
    226226op1 "require_haskell" = \v -> do 
    227227    name    <- fromVal v 

  • src/Pugs/Prim/Yaml.hs

    r8585 r8586  
    3636    return $ VRef (hashRef hv) 
    3737 
    38 dumpYaml :: Val -> Eval Val 
    39 dumpYaml v = do 
    40     obj  <- toYaml =<< fromVal v 
     38dumpYaml :: Int -> Val -> Eval Val 
     39dumpYaml limit v = do 
     40    obj  <- toYaml limit =<< fromVal v 
    4141    rv   <- liftIO (emitYaml obj) 
    4242    case rv of 
    … …  
    4444        Right str -> return $ VStr str 
    4545 
    46 toYaml :: Val -> Eval YamlNode 
    47 toYaml VUndef = return YamlNil 
    48 --toYaml (VNum num) = return $ YamlStr -- better handled by pretty 
    49 toYaml (VStr str) = return $ YamlStr (encodeUTF8 str) 
    50 toYaml (VList nodes) = do 
    51     fmap YamlSeq $ mapM toYaml nodes 
    52 toYaml x = return $ YamlStr $ encodeUTF8 $ pretty x 
    53 --toYaml (VHash hash) = do 
    54 --    fmap YamlMap $ Map.toList hash 
     46toYaml :: Int -> Val -> Eval YamlNode 
     47toYaml 0 _ = return $ YamlStr "<deep recursion>" -- fail? make this configurable? 
     48toYaml _ VUndef = return YamlNil 
     49--toYaml (VNum num) = return $ YamlStr -- better handled by pretty? 
     50toYaml _ (VStr str) = return $ YamlStr (encodeUTF8 str) 
     51toYaml (d+1) (VList nodes) = do 
     52    fmap YamlSeq $ mapM (toYaml d) nodes 
     53toYaml (d+1) v@(VRef r) = do  -- stolen from Pugs.Prim prettyVal. Can these be refactored together? 
     54    v'  <- readRef r 
     55    ifValTypeIsa v "Pair" 
     56        (case v' of 
     57            VList [ks, vs] -> do 
     58                kStr <- toYaml d ks 
     59                vStr <- toYaml d vs 
     60                return $ YamlMap [(kStr, vStr)] -- assume a pair is a one-element hash 
     61            _ -> toYaml d v'                    -- XXX: probably broken to blithingly ignore ref levels here 
     62        ) 
     63        (do nodes <- toYaml d v' 
     64            ifValTypeIsa v "Array" 
     65                (return $ nodes) 
     66                (ifValTypeIsa v "Hash" 
     67                    --(return $ YamlMap('{':(init (tail str))) ++ "}") 
     68                    (return nodes) 
     69                    (return $ YamlMap [(YamlStr "<ref>", nodes)])) -- XXX 
     70        ) 
     71toYaml _ v = return $ YamlStr $ encodeUTF8 $ pretty v 
    5572 
    5673