git.iko.soy/typeable/yaml
on master help sign in
Working yaml library, lots of warnings, alias not written
dc35629Michael Snoyman
.gitignorenew file+2
compare with master
unifiedsplit
@@ -0,0 +1,2 @@
1+dist
2+*.swp
C2HS.hsnew file+220
@@ -0,0 +1,220 @@
1+-- C->Haskell Compiler: Marshalling library
2+--
3+-- Copyright (c) [1999...2005] Manuel M T Chakravarty
4+--
5+-- Redistribution and use in source and binary forms, with or without
6+-- modification, are permitted provided that the following conditions are met:
7+--
8+-- 1. Redistributions of source code must retain the above copyright notice,
9+-- this list of conditions and the following disclaimer.
10+-- 2. Redistributions in binary form must reproduce the above copyright
11+-- notice, this list of conditions and the following disclaimer in the
12+-- documentation and/or other materials provided with the distribution.
13+-- 3. The name of the author may not be used to endorse or promote products
14+-- derived from this software without specific prior written permission.
15+--
16+-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
17+-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
18+-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
19+-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
20+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
21+-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
22+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
24+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
25+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26+--
27+--- Description ---------------------------------------------------------------
28+--
29+-- Language: Haskell 98
30+--
31+-- This module provides the marshaling routines for Haskell files produced by
32+-- C->Haskell for binding to C library interfaces. It exports all of the
33+-- low-level FFI (language-independent plus the C-specific parts) together
34+-- with the C->HS-specific higher-level marshalling routines.
35+--
36+
37+module C2HS (
38+
39+ -- * Re-export the language-independent component of the FFI
40+ module Foreign,
41+
42+ -- * Re-export the C language component of the FFI
43+ module CForeign,
44+
45+ -- * Composite marshalling functions
46+ withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,
47+ peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,
48+
49+ -- * Conditional results using 'Maybe'
50+ nothingIf, nothingIfNull,
51+
52+ -- * Bit masks
53+ combineBitMasks, containsBitMask, extractBitMasks,
54+
55+ -- * Conversion between C and Haskell types
56+ cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum
57+) where
58+
59+
60+import Foreign
61+ hiding (Word)
62+ -- Should also hide the Foreign.Marshal.Pool exports in
63+ -- compilers that export them
64+import CForeign
65+
66+import Monad (when, liftM)
67+
68+
69+-- Composite marshalling functions
70+-- -------------------------------
71+
72+-- Strings with explicit length
73+--
74+withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)
75+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)
76+
77+-- Marshalling of numerals
78+--
79+
80+withIntConv :: (Storable b, Integral a, Integral b)
81+ => a -> (Ptr b -> IO c) -> IO c
82+withIntConv = with . cIntConv
83+
84+withFloatConv :: (Storable b, RealFloat a, RealFloat b)
85+ => a -> (Ptr b -> IO c) -> IO c
86+withFloatConv = with . cFloatConv
87+
88+peekIntConv :: (Storable a, Integral a, Integral b)
89+ => Ptr a -> IO b
90+peekIntConv = liftM cIntConv . peek
91+
92+peekFloatConv :: (Storable a, RealFloat a, RealFloat b)
93+ => Ptr a -> IO b
94+peekFloatConv = liftM cFloatConv . peek
95+
96+-- Passing Booleans by reference
97+--
98+
99+withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b
100+withBool = with . fromBool
101+
102+peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool
103+peekBool = liftM toBool . peek
104+
105+
106+-- Passing enums by reference
107+--
108+
109+withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c
110+withEnum = with . cFromEnum
111+
112+peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a
113+peekEnum = liftM cToEnum . peek
114+
115+
116+-- Storing of 'Maybe' values
117+-- -------------------------
118+
119+instance Storable a => Storable (Maybe a) where
120+ sizeOf _ = sizeOf (undefined :: Ptr ())
121+ alignment _ = alignment (undefined :: Ptr ())
122+
123+ peek p = do
124+ ptr <- peek (castPtr p)
125+ if ptr == nullPtr
126+ then return Nothing
127+ else liftM Just $ peek ptr
128+
129+ poke p v = do
130+ ptr <- case v of
131+ Nothing -> return nullPtr
132+ Just v' -> new v'
133+ poke (castPtr p) ptr
134+
135+
136+-- Conditional results using 'Maybe'
137+-- ---------------------------------
138+
139+-- Wrap the result into a 'Maybe' type.
140+--
141+-- * the predicate determines when the result is considered to be non-existing,
142+-- ie, it is represented by `Nothing'
143+--
144+-- * the second argument allows to map a result wrapped into `Just' to some
145+-- other domain
146+--
147+nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b
148+nothingIf p f x = if p x then Nothing else Just $ f x
149+
150+-- |Instance for special casing null pointers.
151+--
152+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b
153+nothingIfNull = nothingIf (== nullPtr)
154+
155+
156+-- Support for bit masks
157+-- ---------------------
158+
159+-- Given a list of enumeration values that represent bit masks, combine these
160+-- masks using bitwise disjunction.
161+--
162+combineBitMasks :: (Enum a, Bits b) => [a] -> b
163+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)
164+
165+-- Tests whether the given bit mask is contained in the given bit pattern
166+-- (i.e., all bits set in the mask are also set in the pattern).
167+--
168+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool
169+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm
170+ in
171+ bm' .&. bits == bm'
172+
173+-- |Given a bit pattern, yield all bit masks that it contains.
174+--
175+-- * This does *not* attempt to compute a minimal set of bit masks that when
176+-- combined yield the bit pattern, instead all contained bit masks are
177+-- produced.
178+--
179+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]
180+extractBitMasks bits =
181+ [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]
182+
183+
184+-- Conversion routines
185+-- -------------------
186+
187+-- |Integral conversion
188+--
189+cIntConv :: (Integral a, Integral b) => a -> b
190+cIntConv = fromIntegral
191+
192+-- |Floating conversion
193+--
194+cFloatConv :: (RealFloat a, RealFloat b) => a -> b
195+cFloatConv = realToFrac
196+-- As this conversion by default goes via `Rational', it can be very slow...
197+{-# RULES
198+ "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;
199+ "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x
200+ #-}
201+
202+-- |Obtain C value from Haskell 'Bool'.
203+--
204+cFromBool :: Num a => Bool -> a
205+cFromBool = fromBool
206+
207+-- |Obtain Haskell 'Bool' from C value.
208+--
209+cToBool :: Num a => a -> Bool
210+cToBool = toBool
211+
212+-- |Convert a C enumeration to Haskell.
213+--
214+cToEnum :: (Integral i, Enum e) => i -> e
215+cToEnum = toEnum . cIntConv
216+
217+-- |Convert a Haskell enumeration to C.
218+--
219+cFromEnum :: (Enum e, Integral i) => e -> i
220+cFromEnum = cIntConv . fromEnum
LICENSEnew file+25
@@ -0,0 +1,25 @@
1+The following license covers this documentation, and the source code, except
2+where otherwise indicated.
3+
4+Copyright 2008, Michael Snoyman. All rights reserved.
5+
6+Redistribution and use in source and binary forms, with or without
7+modification, are permitted provided that the following conditions are met:
8+
9+* Redistributions of source code must retain the above copyright notice, this
10+ list of conditions and the following disclaimer.
11+
12+* Redistributions in binary form must reproduce the above copyright notice,
13+ this list of conditions and the following disclaimer in the documentation
14+ and/or other materials provided with the distribution.
15+
16+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
17+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
18+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
19+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
20+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
22+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
24+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
25+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README+1
@@ -0,0 +1 @@
1+Support for serialising Haskell to and from Yaml.
Setup.lhsnew file+7
@@ -0,0 +1,7 @@
1+#!/usr/bin/env runhaskell
2+
3+> module Main where
4+> import Distribution.Simple
5+
6+> main :: IO ()
7+> main = defaultMain
Text/Libyaml.chsnew file+293
@@ -0,0 +1,293 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
2+module Text.Libyaml where
3+
4+#include <yaml.h>
5+#include "../../../c/helper.h"
6+
7+import C2HS
8+import qualified Data.ByteString.Internal as B
9+import Control.Monad
10+
11+{#context lib="yaml" #}
12+
13+{#pointer *yaml_parser_t as Parser newtype#}
14+parserSize :: Int
15+parserSize = {#sizeof yaml_parser_t#}
16+
17+{#pointer *yaml_event_t as EventRaw newtype#}
18+eventSize :: Int
19+eventSize = {#sizeof yaml_event_t#}
20+
21+{#fun unsafe yaml_parser_initialize
22+ { id `Parser'
23+ } -> `Int' #}
24+
25+{#fun unsafe yaml_parser_delete
26+ { id `Parser'
27+ } -> `()' #}
28+
29+withParser :: (Parser -> IO a) -> IO a
30+withParser f = do
31+ allocaBytes parserSize $ \p -> do
32+ let p' = Parser p
33+ res <- yaml_parser_initialize p'
34+ -- FIXME check res
35+ ret <- f p'
36+ yaml_parser_delete p'
37+ return ret
38+
39+withEventRaw :: (EventRaw -> IO a) -> IO a
40+withEventRaw f = allocaBytes eventSize $ f . EventRaw
41+
42+{#fun unsafe yaml_parser_set_input_string
43+ { id `Parser'
44+ , id `Ptr CUChar'
45+ , `Int'
46+ } -> `()' #}
47+
48+parserSetInputString :: Parser -> B.ByteString -> IO ()
49+parserSetInputString parser bs = do
50+ let (fptr, offset, len) = B.toForeignPtr bs
51+ let fptr' = castForeignPtr fptr
52+ withForeignPtr fptr' $ \ptr -> do
53+ let ptr' = ptr `plusPtr` offset
54+ yaml_parser_set_input_string parser ptr' len
55+
56+{#fun unsafe yaml_parser_parse
57+ { id `Parser'
58+ , id `EventRaw'
59+ } -> `Int' #}
60+
61+{#fun unsafe yaml_event_delete
62+ { id `EventRaw'
63+ } -> `()' #}
64+
65+parserParse :: Parser -> IO [Event]
66+parserParse parser = do
67+ event <- parserParseOne parser
68+ case event of
69+ EventStreamEnd -> return [event]
70+ _ -> do
71+ rest <- parserParse parser
72+ return $! event : rest
73+
74+parserParseOne :: Parser -> IO Event
75+parserParseOne parser = withEventRaw $ \er -> do
76+ res <- yaml_parser_parse parser er
77+ when (res == 0) $ fail $ "parserParse: " ++ show res
78+ event <- getEvent er
79+ yaml_event_delete er
80+ return event
81+
82+data Event =
83+ EventNone
84+ | EventStreamStart
85+ | EventStreamEnd
86+ | EventDocumentStart
87+ | EventDocumentEnd
88+ | EventAlias
89+ | EventScalar B.ByteString
90+ | EventSequenceStart
91+ | EventSequenceEnd
92+ | EventMappingStart
93+ | EventMappingEnd
94+ deriving (Show)
95+
96+{#enum yaml_event_type_e as EventType {underscoreToCase} deriving (Show) #}
97+getEvent :: EventRaw -> IO Event
98+getEvent (EventRaw ptr) = do
99+ et <- {#get yaml_event_t.type#} ptr
100+ case toEnum $ fromEnum et of
101+ YamlNoEvent -> return EventNone
102+ YamlStreamStartEvent -> return EventStreamStart
103+ YamlStreamEndEvent -> return EventStreamEnd
104+ YamlDocumentStartEvent -> return EventDocumentStart
105+ YamlDocumentEndEvent -> return EventDocumentEnd
106+ YamlAliasEvent -> return EventAlias
107+ YamlScalarEvent -> do
108+ yvalue <- {#get yaml_event_t.data.scalar.value#} ptr
109+ ylen <- {#get yaml_event_t.data.scalar.length#} ptr
110+ let yvalue' = castPtr yvalue
111+ let ylen' = fromEnum ylen
112+ let ylen'' = toEnum $ fromEnum ylen
113+ bs <- B.create ylen' $ \dest -> B.memcpy dest yvalue' ylen''
114+ return $ EventScalar bs
115+ YamlSequenceStartEvent -> return EventSequenceStart
116+ YamlSequenceEndEvent -> return EventSequenceEnd
117+ YamlMappingStartEvent -> return EventMappingStart
118+ YamlMappingEndEvent -> return EventMappingEnd
119+
120+-- Emitter
121+{#pointer *yaml_emitter_t as Emitter newtype#}
122+emitterSize :: Int
123+emitterSize = {#sizeof yaml_emitter_t#}
124+
125+{#fun unsafe yaml_emitter_initialize
126+ { id `Emitter'
127+ } -> `Int' #}
128+
129+{#fun unsafe yaml_emitter_delete
130+ { id `Emitter'
131+ } -> `()' #}
132+
133+{#pointer *buffer_t as Buffer newtype#}
134+bufferSize :: Int
135+bufferSize = {#sizeof buffer_t#}
136+
137+{#fun unsafe buffer_init
138+ { id `Buffer'
139+ } -> `()' #}
140+
141+withBuffer :: (Buffer -> IO ()) -> IO B.ByteString
142+withBuffer f = do
143+ allocaBytes bufferSize $ \b -> do
144+ let b' = Buffer b
145+ buffer_init b'
146+ f b'
147+ ptr <- {#get buffer_t.buff#} b
148+ len <- {#get buffer_t.used#} b
149+ fptr <- newForeignPtr_ $ castPtr ptr
150+ return $! B.fromForeignPtr fptr 0 $ fromIntegral len
151+
152+{#fun unsafe yaml_emitter_set_output
153+ { id `Emitter'
154+ , id `FunPtr (Ptr () -> Ptr CUChar -> CULong -> IO CInt)'
155+ , id `Ptr ()'
156+ } -> `()' #}
157+
158+foreign import ccall "buffer.h &buffer_append"
159+ buffer_append :: FunPtr (Ptr () -> Ptr CUChar -> CULong -> IO CInt)
160+
161+withEmitter :: (Emitter -> IO ()) -> IO B.ByteString
162+withEmitter f = do
163+ allocaBytes emitterSize $ \e -> do
164+ let e' = Emitter e
165+ res <- yaml_emitter_initialize e'
166+ -- FIXME check res
167+ bs <- withBuffer $ \(Buffer b) -> do
168+ let fun = buffer_append
169+ yaml_emitter_set_output e' buffer_append $ castPtr b
170+ f e'
171+ yaml_emitter_delete e'
172+ return bs
173+
174+{#fun unsafe yaml_emitter_emit
175+ { id `Emitter'
176+ , id `EventRaw'
177+ } -> `Int' #}
178+
179+{#fun unsafe print_emitter_error
180+ { id `Emitter'
181+ } -> `()' #}
182+
183+emitEvents :: Emitter -> [Event] -> IO ()
184+emitEvents emitter [] = return ()
185+emitEvents emitter (e:rest) = do
186+ res <- toEventRaw e $ yaml_emitter_emit emitter
187+ when (res == 0) $
188+ print_emitter_error emitter >> fail "yaml_emitter_emit failed"
189+ emitEvents emitter rest
190+
191+{#enum yaml_encoding_e as YamlEncoding {underscoreToCase} deriving (Show) #}
192+{#enum yaml_scalar_style_e as ScalarStyle {underscoreToCase}
193+ deriving (Show) #}
194+
195+enumToIntegral :: (Enum e, Integral i) => e -> i
196+enumToIntegral = fromIntegral . fromEnum
197+
198+{#fun unsafe yaml_stream_start_event_initialize
199+ { id `EventRaw'
200+ , enumToIntegral `YamlEncoding'
201+ } -> `Int' #}
202+
203+{#fun unsafe yaml_stream_end_event_initialize
204+ { id `EventRaw'
205+ } -> `Int' #}
206+
207+{#fun unsafe yaml_scalar_event_initialize
208+ { id `EventRaw'
209+ , id `Ptr CUChar' -- anchor
210+ , id `Ptr CUChar' -- tag
211+ , id `Ptr CUChar' -- value
212+ , `Int'
213+ , `Int'
214+ , `Int'
215+ , enumToIntegral `ScalarStyle'
216+ } -> `Int' #}
217+
218+{#fun unsafe simple_document_start
219+ { id `EventRaw'
220+ } -> `Int' #}
221+
222+{#fun unsafe yaml_document_end_event_initialize
223+ { id `EventRaw'
224+ , `Int'
225+ } -> `Int' #}
226+
227+{#fun unsafe yaml_sequence_start_event_initialize
228+ { id `EventRaw'
229+ , id `Ptr CUChar'
230+ , id `Ptr CUChar'
231+ , `Int'
232+ , `Int'
233+ } -> `Int' #}
234+
235+{#fun unsafe yaml_sequence_end_event_initialize
236+ { id `EventRaw'
237+ } -> `Int' #}
238+
239+{#fun unsafe yaml_mapping_start_event_initialize
240+ { id `EventRaw'
241+ , id `Ptr CUChar'
242+ , id `Ptr CUChar'
243+ , `Int'
244+ , `Int'
245+ } -> `Int' #}
246+
247+{#fun unsafe yaml_mapping_end_event_initialize
248+ { id `EventRaw'
249+ } -> `Int' #}
250+
251+toEventRaw :: Event -> (EventRaw -> IO a) -> IO a
252+toEventRaw e f = withEventRaw $ \er -> do
253+ case e of
254+ EventStreamStart ->
255+ yaml_stream_start_event_initialize er YamlUtf8Encoding
256+ EventStreamEnd ->
257+ yaml_stream_end_event_initialize er
258+ EventDocumentStart ->
259+ simple_document_start er
260+ EventDocumentEnd ->
261+ yaml_document_end_event_initialize er 1
262+ EventScalar bs -> do
263+ let (fvalue, offset, len) = B.toForeignPtr bs
264+ withForeignPtr fvalue $ \value -> do
265+ let value' = value `plusPtr` offset
266+ yaml_scalar_event_initialize
267+ er
268+ nullPtr
269+ nullPtr
270+ value'
271+ len
272+ 0
273+ 1
274+ YamlAnyScalarStyle
275+ EventSequenceStart ->
276+ yaml_sequence_start_event_initialize
277+ er
278+ nullPtr
279+ nullPtr
280+ 1
281+ 0 -- YAML_ANY_SEQUENCE_STYLE
282+ EventSequenceEnd ->
283+ yaml_sequence_end_event_initialize er
284+ EventMappingStart ->
285+ yaml_mapping_start_event_initialize
286+ er
287+ nullPtr
288+ nullPtr
289+ 1
290+ 0 -- YAML_ANY_SEQUENCE_STYLE
291+ EventMappingEnd ->
292+ yaml_mapping_end_event_initialize er
293+ f er
Text/Yaml.hsnew file+89
@@ -0,0 +1,89 @@
1+---------------------------------------------------------
2+--
3+-- Module : Text.Yaml
4+-- Copyright : Michael Snoyman
5+-- License : BSD3
6+--
7+-- Maintainer : Michael Snoyman <michael@snoyman.com>
8+-- Stability : Stable
9+-- Portability : portable
10+--
11+-- Provides a user friendly interface for serializing Yaml data.
12+--
13+---------------------------------------------------------
14+
15+module Text.Yaml
16+ ( module Data.Object
17+ , encode
18+ , encodeFile
19+ , decode
20+ , decodeFile
21+ ) where
22+
23+import Text.Libyaml
24+import qualified Data.ByteString as B
25+import Data.ByteString.Class
26+import Data.Object
27+import System.IO.Unsafe
28+
29+encodeFile :: IsObject o => FilePath -> o -> IO ()
30+encodeFile path o = B.writeFile path $ encode o
31+
32+decodeFile :: (Monad m, IsObject o) => FilePath -> IO (m o)
33+decodeFile path = decode `fmap` B.readFile path
34+
35+encode :: (StrictByteString bs, IsObject o) => o -> bs
36+encode o =
37+ let events = objectToEvents $ toObject o
38+ result = withEmitter $ flip emitEvents $ events
39+ in fromStrictByteString $ unsafePerformIO result
40+
41+decode :: (Monad m, StrictByteString bs, IsObject o) => bs -> m o
42+decode bs = do
43+ let eventsIO = withParser $ \p -> do
44+ parserSetInputString p $ toStrictByteString bs
45+ parserParse p
46+ events = unsafePerformIO eventsIO
47+ fromObject $ eventsToObject events
48+
49+objectToEvents :: Object -> [Event]
50+objectToEvents y = concat
51+ [ [EventStreamStart, EventDocumentStart]
52+ , writeSingle y
53+ , [EventDocumentEnd, EventStreamEnd]] where
54+ writeSingle :: Object -> [Event]
55+ writeSingle (Scalar bs) = [EventScalar bs]
56+ writeSingle (Sequence ys) =
57+ (EventSequenceStart : concatMap writeSingle ys)
58+ ++ [EventSequenceEnd]
59+ writeSingle (Mapping pairs) =
60+ EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
61+ writePair :: (B.ByteString, Object) -> [Event]
62+ writePair (k, v) = EventScalar k : writeSingle v
63+
64+eventsToObject :: [Event] -> Object
65+eventsToObject = fst . readSingle . dropWhile isIgnored where
66+ isIgnored EventAlias = False
67+ isIgnored (EventScalar _) = False
68+ isIgnored EventSequenceStart = False
69+ isIgnored EventSequenceEnd = False
70+ isIgnored EventMappingStart = False
71+ isIgnored EventMappingEnd = False
72+ isIgnored _ = True
73+ readSingle :: [Event] -> (Object, [Event])
74+ readSingle [] = error "readSingle: no more events"
75+ readSingle (EventScalar bs:rest) = (Scalar bs, rest)
76+ readSingle (EventSequenceStart:rest) = readList [] rest
77+ readSingle (EventMappingStart:rest) = readMap [] rest
78+ readSingle (x:rest) = error $ "readSingle: " ++ show x
79+ readList :: [Object] -> [Event] -> (Object, [Event])
80+ readList nodes (EventSequenceEnd:rest) =
81+ (Sequence $ reverse nodes, rest)
82+ readList nodes events =
83+ let (next, rest) = readSingle events
84+ in readList (next : nodes) rest
85+ readMap :: [(B.ByteString, Object)] -> [Event] -> (Object, [Event])
86+ readMap pairs (EventMappingEnd:rest) = (Mapping $ reverse pairs, rest)
87+ readMap pairs (EventScalar bs:events) =
88+ let (next, rest) = readSingle events
89+ in readMap ((fromStrictByteString bs, next) : pairs) rest
c/helper.cnew file+47
@@ -0,0 +1,47 @@
1+#include <stdlib.h>
2+#include <string.h>
3+#include <stdio.h>
4+#include "helper.h"
5+
6+void buffer_init(buffer_t *buffer)
7+{
8+ buffer->buff = 0;
9+ buffer->size = buffer->used = 0;
10+}
11+
12+int buffer_append(void *ext, unsigned char *str, size_t size)
13+{
14+ buffer_t *b = ext;
15+ int new_size, new_used;
16+ char *tmp;
17+
18+ new_used = b->used + size;
19+ for (new_size = b->size || 8; new_size < new_used; new_size *= 2);
20+
21+ if (new_size != b->size) {
22+ tmp = realloc(b->buff, new_size);
23+ if (!tmp) return 0;
24+ b->buff = tmp;
25+ b->size = new_size;
26+ }
27+
28+ memcpy(b->buff + b->used, str, size);
29+ b->used = new_used;
30+
31+ return 1;
32+}
33+
34+void print_emitter_error(yaml_emitter_t *e)
35+{
36+ fprintf(stderr, "%s\n", e->problem);
37+}
38+
39+int simple_document_start(yaml_event_t *e)
40+{
41+ return yaml_document_start_event_initialize
42+ (e,
43+ 0,
44+ 0,
45+ 0,
46+ 1);
47+}
c/helper.hnew file+16
@@ -0,0 +1,16 @@
1+#ifndef __HELPER_H__
2+#define __HELPER_H__
3+
4+#include <yaml.h>
5+
6+typedef struct buffer_s {
7+ char *buff;
8+ unsigned int size, used;
9+} buffer_t;
10+void buffer_init(buffer_t *buffer);
11+int buffer_append(void *ext, unsigned char *str, size_t size);
12+
13+void print_emitter_error(yaml_emitter_t *e);
14+int simple_document_start(yaml_event_t *e);
15+
16+#endif /* __HELPER_H__ */
test/.gitignorenew file+3
@@ -0,0 +1,3 @@
1+hebrew.txt
2+output.yaml
3+output2.yaml
test/hebrew.yamlnew file+1
@@ -0,0 +1 @@
1+שלום
test/input.yamlnew file+2
@@ -0,0 +1,2 @@
1+this is a testש: foobar
2+this is too: foobarbaz
test/test.hsnew file+19
@@ -0,0 +1,19 @@
1+import Text.Yaml
2+import qualified Data.ByteString as B
3+import Control.Monad
4+
5+main = do
6+ contents <- B.readFile "input.yaml"
7+ o <- decode contents
8+ let contents2 = encode (o :: Object)
9+ B.writeFile "output.yaml" contents2
10+ o2 <- decode contents2
11+ print (o2 :: Object)
12+ contents3 <- B.readFile "hebrew.yaml"
13+ o3 <- decode contents3
14+ print (o3 :: B.ByteString)
15+ B.writeFile "hebrew.txt" o3
16+
17+ o4 <- join $ decodeFile "input.yaml"
18+ print (o4 :: Object)
19+ encodeFile "output2.yaml" o4
yaml.cabalnew file+26
@@ -0,0 +1,26 @@
1+name: yaml
2+version: 0.0.0
3+license: BSD3
4+license-file: LICENSE
5+author: Michael Snoyman <michael@snoyman.com>
6+maintainer: Michael Snoyman <michael@snoyman.com>
7+synopsis: Support for serialising Haskell to and from Yaml.
8+description: Binds to the libyaml library
9+category: Web
10+stability: unstable
11+cabal-version: >= 1.2
12+build-type: Simple
13+homepage: http://github.com/snoyberg/yaml/tree/master
14+
15+library
16+ build-depends: base >= 4 && < 5,
17+ bytestring-class,
18+ data-object,
19+ bytestring >= 0.9.1.4 && < 1,
20+ haskell98
21+ exposed-modules: Text.Yaml
22+ other-modules: Text.Libyaml,
23+ C2HS
24+ ghc-options: -Wall
25+ c-sources: c/helper.c
26+ extra-libraries: yaml