yaml 0.0.1 → 0.0.2
raw patch · 6 files changed
+351/−524 lines, 6 files
Files
- C2HS.hs +0/−220
- Text/Libyaml.chs +0/−299
- Text/Libyaml.hs +310/−0
- c/helper.c +30/−0
- c/helper.h +9/−1
- yaml.cabal +2/−4
− C2HS.hs
@@ -1,220 +0,0 @@--- C->Haskell Compiler: Marshalling library------ Copyright (c) [1999...2005] Manuel M T Chakravarty------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- --- 1. Redistributions of source code must retain the above copyright notice,--- this list of conditions and the following disclaimer. --- 2. Redistributions in binary form must reproduce the above copyright--- notice, this list of conditions and the following disclaimer in the--- documentation and/or other materials provided with the distribution. --- 3. The name of the author may not be used to endorse or promote products--- derived from this software without specific prior written permission. ------ THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR--- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES--- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN--- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED--- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description --------------------------------------------------------------------- Language: Haskell 98------ This module provides the marshaling routines for Haskell files produced by --- C->Haskell for binding to C library interfaces. It exports all of the--- low-level FFI (language-independent plus the C-specific parts) together--- with the C->HS-specific higher-level marshalling routines.-----module C2HS (-- -- * Re-export the language-independent component of the FFI - module Foreign,-- -- * Re-export the C language component of the FFI- module CForeign,-- -- * Composite marshalling functions- withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,- peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,-- -- * Conditional results using 'Maybe'- nothingIf, nothingIfNull,-- -- * Bit masks- combineBitMasks, containsBitMask, extractBitMasks,-- -- * Conversion between C and Haskell types- cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where ---import Foreign- hiding (Word)- -- Should also hide the Foreign.Marshal.Pool exports in- -- compilers that export them-import CForeign--import Monad (when, liftM)----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c-withIntConv = with . cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c-withFloatConv = with . cFloatConv--peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b-peekIntConv = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b-peekFloatConv = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum = with . cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where- sizeOf _ = sizeOf (undefined :: Ptr ())- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- ptr <- peek (castPtr p)- if ptr == nullPtr- then return Nothing- else liftM Just $ peek ptr-- poke p v = do- ptr <- case v of- Nothing -> return nullPtr- Just v' -> new v'- poke (castPtr p) ptr----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,--- ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some--- other domain----nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm- in- bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when--- combined yield the bit pattern, instead all contained bit masks are--- produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits = - [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES - "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;- "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum = cIntConv . fromEnum
− Text/Libyaml.chs
@@ -1,299 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-module Text.Libyaml- ( Event (..)- , parserParse- , withParser- , emitEvents- , withEmitter- ) where--#include <yaml.h>-#include <helper.h>--import C2HS-import qualified Data.ByteString.Internal as B-import Control.Monad--{#context lib="yaml" #}--{#pointer *yaml_parser_t as Parser newtype#}-parserSize :: Int-parserSize = {#sizeof yaml_parser_t#}--{#pointer *yaml_event_t as EventRaw newtype#}-eventSize :: Int-eventSize = {#sizeof yaml_event_t#}--{#fun unsafe yaml_parser_initialize- { id `Parser'- } -> `Int' #}--{#fun unsafe yaml_parser_delete- { id `Parser'- } -> `()' #}--withParser :: B.ByteString -> (Parser -> IO a) -> IO a-withParser bs f = do- allocaBytes parserSize $ \p ->- do- let p' = Parser p- _res <- yaml_parser_initialize p'- -- FIXME check res- let (fptr, offset, len) = B.toForeignPtr bs- ret <- withForeignPtr fptr $ \ptr ->- do- let ptr' = castPtr ptr `plusPtr` offset- yaml_parser_set_input_string p' ptr' len- f p'- yaml_parser_delete p'- return ret--withEventRaw :: (EventRaw -> IO a) -> IO a-withEventRaw f = allocaBytes eventSize $ f . EventRaw--{#fun unsafe yaml_parser_set_input_string- { id `Parser'- , id `Ptr CUChar'- , `Int'- } -> `()' #}--{#fun unsafe yaml_parser_parse- { id `Parser'- , id `EventRaw'- } -> `Int' #}--{#fun unsafe yaml_event_delete- { id `EventRaw'- } -> `()' #}--parserParse :: Parser -> IO [Event]-parserParse parser = do- event <- parserParseOne parser- case event of- EventStreamEnd -> return [event]- _ -> do- rest <- parserParse parser- return $! event : rest--{#fun unsafe print_parser_error- { id `Parser'- } -> `()' #}--parserParseOne :: Parser -> IO Event-parserParseOne parser = withEventRaw $ \er -> do- res <- yaml_parser_parse parser er- when (res == 0) $- print_parser_error parser >> fail "yaml_parser_parse failed"- event <- getEvent er- yaml_event_delete er- return event--data Event =- EventNone- | EventStreamStart- | EventStreamEnd- | EventDocumentStart- | EventDocumentEnd- | EventAlias- | EventScalar B.ByteString- | EventSequenceStart- | EventSequenceEnd- | EventMappingStart- | EventMappingEnd- deriving (Show)--{#enum yaml_event_type_e as EventType {underscoreToCase} deriving (Show) #}-getEvent :: EventRaw -> IO Event-getEvent (EventRaw ptr') = do- et <- {#get yaml_event_t.type#} ptr'- case toEnum $ fromEnum et of- YamlNoEvent -> return EventNone- YamlStreamStartEvent -> return EventStreamStart- YamlStreamEndEvent -> return EventStreamEnd- YamlDocumentStartEvent -> return EventDocumentStart- YamlDocumentEndEvent -> return EventDocumentEnd- YamlAliasEvent -> return EventAlias- YamlScalarEvent -> do- yvalue <- {#get yaml_event_t.data.scalar.value#} ptr'- ylen <- {#get yaml_event_t.data.scalar.length#} ptr'- let yvalue' = castPtr yvalue- let ylen' = fromEnum ylen- let ylen'' = toEnum $ fromEnum ylen- bs <- B.create ylen' $ \dest -> B.memcpy dest yvalue' ylen''- return $ EventScalar bs- YamlSequenceStartEvent -> return EventSequenceStart- YamlSequenceEndEvent -> return EventSequenceEnd- YamlMappingStartEvent -> return EventMappingStart- YamlMappingEndEvent -> return EventMappingEnd---- Emitter-{#pointer *yaml_emitter_t as Emitter newtype#}-emitterSize :: Int-emitterSize = {#sizeof yaml_emitter_t#}--{#fun unsafe yaml_emitter_initialize- { id `Emitter'- } -> `Int' #}--{#fun unsafe yaml_emitter_delete- { id `Emitter'- } -> `()' #}--{#pointer *buffer_t as Buffer newtype#}-bufferSize :: Int-bufferSize = {#sizeof buffer_t#}--{#fun unsafe buffer_init- { id `Buffer'- } -> `()' #}--withBuffer :: (Buffer -> IO ()) -> IO B.ByteString-withBuffer f = do- allocaBytes bufferSize $ \b -> do- let b' = Buffer b- buffer_init b'- f b'- ptr' <- {#get buffer_t.buff#} b- len <- {#get buffer_t.used#} b- fptr <- newForeignPtr_ $ castPtr ptr'- return $! B.fromForeignPtr fptr 0 $ fromIntegral len--{#fun unsafe yaml_emitter_set_output- { id `Emitter'- , id `FunPtr (Ptr () -> Ptr CUChar -> CULong -> IO CInt)'- , id `Ptr ()'- } -> `()' #}--foreign import ccall "buffer.h &buffer_append"- buffer_append :: FunPtr (Ptr () -> Ptr CUChar -> CULong -> IO CInt)--withEmitter :: (Emitter -> IO ()) -> IO B.ByteString-withEmitter f = do- allocaBytes emitterSize $ \e -> do- let e' = Emitter e- _res <- yaml_emitter_initialize e'- -- FIXME check res- bs <- withBuffer $ \(Buffer b) -> do- let fun = buffer_append- yaml_emitter_set_output e' buffer_append $ castPtr b- f e'- yaml_emitter_delete e'- return bs--{#fun unsafe yaml_emitter_emit- { id `Emitter'- , id `EventRaw'- } -> `Int' #}--{#fun unsafe print_emitter_error- { id `Emitter'- } -> `()' #}--emitEvents :: Emitter -> [Event] -> IO ()-emitEvents _ [] = return ()-emitEvents emitter (e:rest) = do- res <- toEventRaw e $ yaml_emitter_emit emitter- when (res == 0) $- print_emitter_error emitter >> fail "yaml_emitter_emit failed"- emitEvents emitter rest--{#fun unsafe yaml_stream_start_event_initialize- { id `EventRaw'- , `Int'- } -> `Int' #}--{#fun unsafe yaml_stream_end_event_initialize- { id `EventRaw'- } -> `Int' #}--{#fun unsafe yaml_scalar_event_initialize- { id `EventRaw'- , id `Ptr CUChar' -- anchor- , id `Ptr CUChar' -- tag- , id `Ptr CUChar' -- value- , `Int'- , `Int'- , `Int'- , `Int'- } -> `Int' #}--{#fun unsafe simple_document_start- { id `EventRaw'- } -> `Int' #}--{#fun unsafe yaml_document_end_event_initialize- { id `EventRaw'- , `Int'- } -> `Int' #}--{#fun unsafe yaml_sequence_start_event_initialize- { id `EventRaw'- , id `Ptr CUChar'- , id `Ptr CUChar'- , `Int'- , `Int'- } -> `Int' #}--{#fun unsafe yaml_sequence_end_event_initialize- { id `EventRaw'- } -> `Int' #}--{#fun unsafe yaml_mapping_start_event_initialize- { id `EventRaw'- , id `Ptr CUChar'- , id `Ptr CUChar'- , `Int'- , `Int'- } -> `Int' #}--{#fun unsafe yaml_mapping_end_event_initialize- { id `EventRaw'- } -> `Int' #}--toEventRaw :: Event -> (EventRaw -> IO a) -> IO a-toEventRaw e f = withEventRaw $ \er -> do- case e of- EventStreamStart ->- yaml_stream_start_event_initialize- er- 0 -- YAML_ANY_ENCODING- EventStreamEnd ->- yaml_stream_end_event_initialize er- EventDocumentStart ->- simple_document_start er- EventDocumentEnd ->- yaml_document_end_event_initialize er 1- EventScalar bs -> do- let (fvalue, offset, len) = B.toForeignPtr bs- withForeignPtr fvalue $ \value -> do- let value' = value `plusPtr` offset- yaml_scalar_event_initialize- er- nullPtr- nullPtr- value'- len- 0- 1- 0 -- YAML_ANY_SCALAR_STYLE- EventSequenceStart ->- yaml_sequence_start_event_initialize- er- nullPtr- nullPtr- 1- 0 -- YAML_ANY_SEQUENCE_STYLE- EventSequenceEnd ->- yaml_sequence_end_event_initialize er- EventMappingStart ->- yaml_mapping_start_event_initialize- er- nullPtr- nullPtr- 1- 0 -- YAML_ANY_SEQUENCE_STYLE- EventMappingEnd ->- yaml_mapping_end_event_initialize er- EventAlias -> error "toEventRaw: EventAlias not supported"- EventNone -> error "toEventRaw: EventNone not supported"- f er
+ Text/Libyaml.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}++{-# INCLUDE <yaml.h> #-}+{-# INCLUDE <helper.h> #-}+module Text.Libyaml+{-+ (+ Event (..)+ , parserParse+ , withParser+ , emitEvents+ , withEmitter+ )-} where++import qualified Data.ByteString.Internal as B+import Control.Monad+import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc++data ParserStruct+type Parser = Ptr ParserStruct+parserSize :: Int+parserSize = 480++data EventRawStruct+type EventRaw = Ptr EventRawStruct+eventSize :: Int+eventSize = 104++foreign import ccall unsafe "yaml_parser_initialize"+ c_yaml_parser_initialize :: Parser -> IO CInt++foreign import ccall unsafe "yaml_parser_delete"+ c_yaml_parser_delete :: Parser -> IO ()++foreign import ccall unsafe "yaml_parser_set_input_string"+ c_yaml_parser_set_input_string :: Parser+ -> Ptr CUChar+ -> CULong+ -> IO ()++withParser :: B.ByteString -> (Parser -> IO a) -> IO a+withParser bs f = do+ allocaBytes parserSize $ \p ->+ do+ _res <- c_yaml_parser_initialize p+ -- FIXME check res+ let (fptr, offset, len) = B.toForeignPtr bs+ ret <- withForeignPtr fptr $ \ptr ->+ do+ let ptr' = castPtr ptr `plusPtr` offset+ len' = fromIntegral len+ c_yaml_parser_set_input_string p ptr' len'+ f p+ c_yaml_parser_delete p+ return ret++withEventRaw :: (EventRaw -> IO a) -> IO a+withEventRaw f = allocaBytes eventSize $ f++foreign import ccall unsafe "yaml_parser_parse"+ c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt++foreign import ccall unsafe "yaml_event_delete"+ c_yaml_event_delete :: EventRaw -> IO ()++foreign import ccall "print_parser_error"+ c_print_parser_error :: Parser -> IO ()++parserParseOne :: Parser -> IO Event+parserParseOne parser = withEventRaw $ \er -> do+ res <- c_yaml_parser_parse parser er+ when (res == 0) $+ c_print_parser_error parser >> fail "yaml_parser_parse failed"+ event <- getEvent er+ c_yaml_event_delete er+ return event++data Event =+ EventNone+ | EventStreamStart+ | EventStreamEnd+ | EventDocumentStart+ | EventDocumentEnd+ | EventAlias+ | EventScalar B.ByteString+ | EventSequenceStart+ | EventSequenceEnd+ | EventMappingStart+ | EventMappingEnd+ deriving (Show)++data EventType = YamlNoEvent+ | YamlStreamStartEvent+ | YamlStreamEndEvent+ | YamlDocumentStartEvent+ | YamlDocumentEndEvent+ | YamlAliasEvent+ | YamlScalarEvent+ | YamlSequenceStartEvent+ | YamlSequenceEndEvent+ | YamlMappingStartEvent+ | YamlMappingEndEvent+ deriving (Enum,Show)++foreign import ccall unsafe "get_event_type"+ c_get_event_type :: EventRaw -> IO CInt++foreign import ccall unsafe "get_scalar_value"+ c_get_scalar_value :: EventRaw -> IO (Ptr CUChar)++foreign import ccall unsafe "get_scalar_length"+ c_get_scalar_length :: EventRaw -> IO CULong++getEvent :: EventRaw -> IO Event+getEvent er = do+ et <- c_get_event_type er+ case toEnum $ fromEnum et of+ YamlNoEvent -> return EventNone+ YamlStreamStartEvent -> return EventStreamStart+ YamlStreamEndEvent -> return EventStreamEnd+ YamlDocumentStartEvent -> return EventDocumentStart+ YamlDocumentEndEvent -> return EventDocumentEnd+ YamlAliasEvent -> return EventAlias+ YamlScalarEvent -> do+ yvalue <- c_get_scalar_value er+ ylen <- c_get_scalar_length er+ let yvalue' = castPtr yvalue+ let ylen' = fromEnum ylen+ let ylen'' = toEnum $ fromEnum ylen+ bs <- B.create ylen' $ \dest -> B.memcpy dest yvalue' ylen''+ return $ EventScalar bs+ YamlSequenceStartEvent -> return EventSequenceStart+ YamlSequenceEndEvent -> return EventSequenceEnd+ YamlMappingStartEvent -> return EventMappingStart+ YamlMappingEndEvent -> return EventMappingEnd++parserParse :: Parser -> IO [Event]+parserParse parser = do+ event <- parserParseOne parser+ case event of+ EventStreamEnd -> return [event]+ _ -> do+ rest <- parserParse parser+ return $! event : rest++-- Emitter++data EmitterStruct+type Emitter = Ptr EmitterStruct+emitterSize :: Int+emitterSize = 432++foreign import ccall unsafe "yaml_emitter_initialize"+ c_yaml_emitter_initialize :: Emitter -> IO CInt++foreign import ccall unsafe "yaml_emitter_delete"+ c_yaml_emitter_delete :: Emitter -> IO ()++data BufferStruct+type Buffer = Ptr BufferStruct+bufferSize :: Int+bufferSize = 16++foreign import ccall unsafe "buffer_init"+ c_buffer_init :: Buffer -> IO ()++foreign import ccall unsafe "get_buffer_buff"+ c_get_buffer_buff :: Buffer -> IO (Ptr CUChar)++foreign import ccall unsafe "get_buffer_used"+ c_get_buffer_used :: Buffer -> IO CULong++withBuffer :: (Buffer -> IO ()) -> IO B.ByteString+withBuffer f = do+ allocaBytes bufferSize $ \b -> do+ c_buffer_init b+ f b+ ptr' <- c_get_buffer_buff b+ len <- c_get_buffer_used b+ fptr <- newForeignPtr_ $ castPtr ptr'+ return $! B.fromForeignPtr fptr 0 $ fromIntegral len++foreign import ccall unsafe "my_emitter_set_output"+ c_my_emitter_set_output :: Emitter -> Buffer -> IO ()++withEmitter :: (Emitter -> IO ()) -> IO B.ByteString+withEmitter f = do+ allocaBytes emitterSize $ \e -> do+ _res <- c_yaml_emitter_initialize e+ -- FIXME check res+ bs <- withBuffer $ \b -> do+ c_my_emitter_set_output e b+ f e+ c_yaml_emitter_delete e+ return bs++foreign import ccall unsafe "yaml_emitter_emit"+ c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt++foreign import ccall unsafe "print_emitter_error"+ c_print_emitter_error :: Emitter -> IO ()++emitEvents :: Emitter -> [Event] -> IO ()+emitEvents _ [] = return ()+emitEvents emitter (e:rest) = do+ res <- toEventRaw e $ c_yaml_emitter_emit emitter+ when (res == 0) $+ c_print_emitter_error emitter >> fail "yaml_emitter_emit failed"+ emitEvents emitter rest++foreign import ccall unsafe "yaml_stream_start_event_initialize"+ c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt++foreign import ccall unsafe "yaml_stream_end_event_initialize"+ c_yaml_stream_end_event_initialize :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_scalar_event_initialize"+ c_yaml_scalar_event_initialize+ :: EventRaw+ -> Ptr CUChar -- anchor+ -> Ptr CUChar -- tag+ -> Ptr CUChar -- value+ -> CInt+ -> CInt+ -> CInt+ -> CInt+ -> IO CInt++foreign import ccall unsafe "simple_document_start"+ c_simple_document_start :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_document_end_event_initialize"+ c_yaml_document_end_event_initialize :: EventRaw -> CInt -> IO CInt++foreign import ccall unsafe "yaml_sequence_start_event_initialize"+ c_yaml_sequence_start_event_initialize+ :: EventRaw+ -> Ptr CUChar+ -> Ptr CUChar+ -> CInt+ -> CInt+ -> IO CInt++foreign import ccall unsafe "yaml_sequence_end_event_initialize"+ c_yaml_sequence_end_event_initialize :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_mapping_start_event_initialize"+ c_yaml_mapping_start_event_initialize+ :: EventRaw+ -> Ptr CUChar+ -> Ptr CUChar+ -> CInt+ -> CInt+ -> IO CInt++foreign import ccall unsafe "yaml_mapping_end_event_initialize"+ c_yaml_mapping_end_event_initialize :: EventRaw -> IO CInt++toEventRaw :: Event -> (EventRaw -> IO a) -> IO a+toEventRaw e f = withEventRaw $ \er -> do+ case e of+ EventStreamStart ->+ c_yaml_stream_start_event_initialize+ er+ 0 -- YAML_ANY_ENCODING+ EventStreamEnd ->+ c_yaml_stream_end_event_initialize er+ EventDocumentStart ->+ c_simple_document_start er+ EventDocumentEnd ->+ c_yaml_document_end_event_initialize er 1+ EventScalar bs -> do+ let (fvalue, offset, len) = B.toForeignPtr bs+ withForeignPtr fvalue $ \value -> do+ let value' = value `plusPtr` offset+ len' = fromIntegral len+ c_yaml_scalar_event_initialize+ er+ nullPtr+ nullPtr+ value'+ len'+ 0+ 1+ 0 -- YAML_ANY_SCALAR_STYLE+ EventSequenceStart ->+ c_yaml_sequence_start_event_initialize+ er+ nullPtr+ nullPtr+ 1+ 0 -- YAML_ANY_SEQUENCE_STYLE+ EventSequenceEnd ->+ c_yaml_sequence_end_event_initialize er+ EventMappingStart ->+ c_yaml_mapping_start_event_initialize+ er+ nullPtr+ nullPtr+ 1+ 0 -- YAML_ANY_SEQUENCE_STYLE+ EventMappingEnd ->+ c_yaml_mapping_end_event_initialize er+ EventAlias -> error "toEventRaw: EventAlias not supported"+ EventNone -> error "toEventRaw: EventNone not supported"+ f er
c/helper.c view
@@ -31,6 +31,21 @@ return 1; } +unsigned char * get_buffer_buff(buffer_t *b)+{+ return b->buff;+}++unsigned int get_buffer_used(buffer_t *b)+{+ return b->used;+}++void my_emitter_set_output(yaml_emitter_t *e, buffer_t *b)+{+ yaml_emitter_set_output(e, buffer_append, b);+}+ void print_parser_error(yaml_parser_t *p) { fprintf(stderr, "Problem: %s\nContext: %s\nOffset: %u\n",@@ -52,4 +67,19 @@ 0, 0, 1);+}++int get_event_type(yaml_event_t *e)+{+ return e->type;+}++unsigned char * get_scalar_value(yaml_event_t *e)+{+ return e->data.scalar.value;+}++unsigned long get_scalar_length(yaml_event_t *e)+{+ return e->data.scalar.length; }
c/helper.h view
@@ -4,14 +4,22 @@ #include <yaml.h> typedef struct buffer_s {- char *buff;+ unsigned char *buff; unsigned int size, used; } buffer_t; void buffer_init(buffer_t *buffer); int buffer_append(void *ext, unsigned char *str, size_t size);+unsigned char * get_buffer_buff(buffer_t *b);+unsigned int get_buffer_used(buffer_t *b); +void my_emitter_set_output(yaml_emitter_t *e, buffer_t *b);+ void print_parser_error(yaml_parser_t *p); void print_emitter_error(yaml_emitter_t *e); int simple_document_start(yaml_event_t *e);++int get_event_type(yaml_event_t *e);+unsigned char * get_scalar_value(yaml_event_t *e);+unsigned long get_scalar_length(yaml_event_t *e); #endif /* __HELPER_H__ */
yaml.cabal view
@@ -1,5 +1,5 @@ name: yaml-version: 0.0.1+version: 0.0.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -22,8 +22,7 @@ bytestring >= 0.9.1.4 && < 1, haskell98 exposed-modules: Text.Yaml- other-modules: Text.Libyaml,- C2HS+ other-modules: Text.Libyaml ghc-options: -Wall c-sources: c/helper.c, c/api.c,@@ -35,4 +34,3 @@ c/scanner.c, c/writer.c include-dirs: c- build-tools: c2hs