-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Text/JSON/YAJL.chs" #-}-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}
module Text.JSON.YAJL
	(
	-- * Parser
	  Parser
	, ParseStatus (..)
	, newParserIO
	, newParserST
	
	-- ** Parser callbacks
	, Callback
	, setCallback
	, clearCallback
	
	-- *** Containers
	, parsedBeginArray
	, parsedEndArray
	, parsedBeginObject
	, parsedEndObject
	
	-- *** Basic values
	, parsedNull
	, parsedBoolean
	
	-- *** Numeric callbacks
	, parsedInteger
	, parsedDouble
	, parsedNumber
	
	-- *** Text callbacks
	, parsedAttributeText
	, parsedAttributeBytes
	, parsedAttributeBuffer
	
	, parsedText
	, parsedBytes
	, parsedBuffer
	
	-- ** Parser input
	, parseText
	, parseLazyText
	, parseBytes
	, parseLazyBytes
	, parseBuffer
	, parseComplete
	, getBytesConsumed
	
	-- * Generator
	, Generator
	, GeneratorConfig (..)
	, GeneratorError (..)
	, newGenerator
	, getBuffer
	, clearBuffer
	
	-- ** Generator events
	, generateNull
	, generateBoolean
	, generateIntegral
	, generateDouble
	, generateNumber
	, generateText
	, generateBeginArray
	, generateEndArray
	, generateBeginObject
	, generateEndObject
	) where
import qualified Control.Exception as E
import qualified Control.Monad.ST as ST
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import Data.Typeable (Typeable)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Foreign.Concurrent as FC

-- import unqualified for C2Hs
import Foreign hiding (free)
import Foreign.C


newtype ParserHandle = ParserHandle (Ptr (ParserHandle))
{-# LINE 106 "./Text/JSON/YAJL.chs" #-}

data Parser m = Parser
	{ parserHandle :: ForeignPtr ParserHandle
	, parserCallbacks :: ForeignPtr ()
	, parserErrorRef :: IORef (Maybe E.SomeException)
	, parserToIO :: forall a. m a -> IO a
	, parserFromIO :: forall a. IO a -> m a
	}

data ParseStatus
	= ParseFinished
	| ParseContinue
	-- ^ More input is required before parsing can complete.
	
	| ParseCancelled
	-- ^ A callback returned 'False'.
	
	| ParseError T.Text
	-- ^ An error occured while parsing. The included message contains
	-- details about the error.
	
	deriving (Show, Eq)

newParserIO :: IO (Parser IO)
newParserIO = E.block $ do
	ref <- newIORef Nothing
	cCallbacks <- mallocForeignPtrBytes 44
{-# LINE 133 "./Text/JSON/YAJL.chs" #-}
	ParserHandle handlePtr <- withForeignPtr cCallbacks $ \raw -> do
		memset raw 0 44
{-# LINE 135 "./Text/JSON/YAJL.chs" #-}
		FC.addForeignPtrFinalizer cCallbacks $ freeParserCallbacks raw
		
		-- TODO: set checkUTF8 flag
		
		yajl_alloc raw nullPtr nullPtr nullPtr
	parserFP <- newForeignPtr cParserFree handlePtr
	return $ Parser parserFP cCallbacks ref id id

newParserST :: ST.ST s (Parser (ST.ST s))
newParserST = ST.unsafeIOToST $ do
	p <- newParserIO
	return $ p
		{ parserToIO = ST.unsafeSTToIO
		, parserFromIO = ST.unsafeIOToST
		}

freeParserCallbacks :: Ptr () -> IO ()
freeParserCallbacks raw = do
	(\ptr -> do {peekByteOff ptr 0 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 4 ::IO (FunPtr ((Ptr ()) -> (CInt -> (IO CInt))))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 16 ::IO (FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (IO CInt)))))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 20 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 24 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 28 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 32 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 36 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))}) raw >>= freeFunPtr
	(\ptr -> do {peekByteOff ptr 40 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))}) raw >>= freeFunPtr

foreign import ccall "yajl/yajl_parse.h &yajl_free"
	cParserFree :: FunPtr (Ptr ParserHandle -> IO ())

-- | A callback should return 'True' to continue parsing, or 'False'
-- to cancel.
--
data Callback m a = Callback (Parser m -> a -> IO ()) (Parser m -> IO ())

setCallback :: Parser m -> Callback m a -> a -> m ()
setCallback p (Callback set _) io = parserFromIO p $ set p io

clearCallback :: Parser m -> Callback m a -> m ()
clearCallback p (Callback _ clear) = parserFromIO p $ clear p

-- Callback wrappers
type Callback0 = Ptr () -> IO CInt
type CallbackBool = Ptr () -> CInt -> IO CInt
type CallbackLong = Ptr () -> CLong -> IO CInt
type CallbackDouble = Ptr () -> CDouble -> IO CInt
type CallbackBuf = Ptr () -> Ptr CChar -> CUInt -> IO CInt
type CallbackUBuf = Ptr () -> Ptr CUChar -> CUInt -> IO CInt

catchRef :: Parser m -> m Bool -> IO CInt
catchRef p io = do
	continue <- E.catch (E.unblock (parserToIO p io)) $ \e -> do
		writeIORef (parserErrorRef p) $ Just e
		return False
	return $ cFromBool continue

wrapCallback0 :: Parser m -> m Bool -> IO (FunPtr Callback0)
wrapCallback0 p io = allocCallback0 $ \_ -> catchRef p io

wrapCallbackBool :: Parser m -> (Bool -> m Bool) -> IO (FunPtr CallbackBool)
wrapCallbackBool p io = allocCallbackBool $ \_ -> catchRef p . io . cToBool

wrapCallbackLong :: Parser m -> (Integer -> m Bool) -> IO (FunPtr CallbackLong)
wrapCallbackLong p io = allocCallbackLong $ \_ -> catchRef p . io . toInteger

wrapCallbackDouble :: Parser m -> (Double -> m Bool) -> IO (FunPtr CallbackDouble)
wrapCallbackDouble p io = allocCallbackDouble $ \_ -> catchRef p . io . realToFrac

wrapCallbackText :: Parser m -> (T.Text -> m Bool) -> IO (FunPtr CallbackUBuf)
wrapCallbackText p cb = wrapCallbackBytes p (cb . TE.decodeUtf8)

wrapCallbackBytes' :: Parser m -> (B.ByteString -> m Bool) -> IO (FunPtr CallbackBuf)
wrapCallbackBytes' p io =
	allocCallbackBuf $ \_ cstr len ->
	catchRef p $ parserFromIO p $ do
		bytes <- B.packCStringLen (castPtr cstr, fromIntegral len)
		parserToIO p $ io bytes

wrapCallbackBytes :: Parser m -> (B.ByteString -> m Bool) -> IO (FunPtr CallbackUBuf)
wrapCallbackBytes p io =
	allocCallbackUBuf $ \_ cstr len ->
	catchRef p $ parserFromIO p $ do
		bytes <- B.packCStringLen (castPtr cstr, fromIntegral len)
		parserToIO p $ io bytes

wrapCallbackBuffer :: Parser m -> ((Ptr Word8, Integer) -> m Bool) -> IO (FunPtr CallbackUBuf)
wrapCallbackBuffer p io =
	allocCallbackUBuf $ \_ cstr len ->
	catchRef p $
	io (castPtr cstr, toInteger len)

foreign import ccall "wrapper"
	allocCallback0 :: Callback0 -> IO (FunPtr Callback0)

foreign import ccall "wrapper"
	allocCallbackBool :: CallbackBool -> IO (FunPtr CallbackBool)

foreign import ccall "wrapper"
	allocCallbackLong :: CallbackLong -> IO (FunPtr CallbackLong)

foreign import ccall "wrapper"
	allocCallbackDouble :: CallbackDouble -> IO (FunPtr CallbackDouble)

foreign import ccall "wrapper"
	allocCallbackBuf :: CallbackBuf -> IO (FunPtr CallbackBuf)

foreign import ccall "wrapper"
	allocCallbackUBuf :: CallbackUBuf -> IO (FunPtr CallbackUBuf)

freeFunPtr :: FunPtr a -> IO ()
freeFunPtr ptr = if ptr == nullFunPtr
	then return ()
	else freeHaskellFunPtr ptr

callback :: (Parser m -> a -> IO (FunPtr b))
         -> (Ptr () -> IO (FunPtr b))
         -> (Ptr () -> FunPtr b -> IO ())
         -> Callback m a
callback wrap getPtr setPtr = Callback set clear where
	set parser io = withForeignPtr (parserCallbacks parser) $ \p -> do
		free p
		wrap parser io >>= setPtr p
	clear parser = withForeignPtr (parserCallbacks parser) $ \p -> do
		free p
		setPtr p nullFunPtr
	free p = getPtr p >>= freeFunPtr

parsedBeginArray :: Callback m (m Bool)
parsedBeginArray = callback wrapCallback0
	(\ptr -> do {peekByteOff ptr 36 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))})
{-# LINE 266 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 36 (val::(FunPtr ((Ptr ()) -> (IO CInt))))})
{-# LINE 267 "./Text/JSON/YAJL.chs" #-}

parsedEndArray :: Callback m (m Bool)
parsedEndArray = callback wrapCallback0
	(\ptr -> do {peekByteOff ptr 40 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))})
{-# LINE 271 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 40 (val::(FunPtr ((Ptr ()) -> (IO CInt))))})
{-# LINE 272 "./Text/JSON/YAJL.chs" #-}

parsedBeginObject :: Callback m (m Bool)
parsedBeginObject = callback wrapCallback0
	(\ptr -> do {peekByteOff ptr 24 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))})
{-# LINE 276 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 24 (val::(FunPtr ((Ptr ()) -> (IO CInt))))})
{-# LINE 277 "./Text/JSON/YAJL.chs" #-}

parsedEndObject :: Callback m (m Bool)
parsedEndObject = callback wrapCallback0
	(\ptr -> do {peekByteOff ptr 32 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))})
{-# LINE 281 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 32 (val::(FunPtr ((Ptr ()) -> (IO CInt))))})
{-# LINE 282 "./Text/JSON/YAJL.chs" #-}

parsedNull :: Callback m (m Bool)
parsedNull = callback wrapCallback0
	(\ptr -> do {peekByteOff ptr 0 ::IO (FunPtr ((Ptr ()) -> (IO CInt)))})
{-# LINE 286 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 0 (val::(FunPtr ((Ptr ()) -> (IO CInt))))})
{-# LINE 287 "./Text/JSON/YAJL.chs" #-}

parsedBoolean :: Callback m (Bool -> m Bool)
parsedBoolean = callback wrapCallbackBool
	(\ptr -> do {peekByteOff ptr 4 ::IO (FunPtr ((Ptr ()) -> (CInt -> (IO CInt))))})
{-# LINE 291 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 4 (val::(FunPtr ((Ptr ()) -> (CInt -> (IO CInt)))))})
{-# LINE 292 "./Text/JSON/YAJL.chs" #-}

parsedInteger :: Callback m (Integer -> m Bool)
parsedInteger = callback wrapCallbackLong
	(\ptr -> do {peekByteOff ptr 8 ::IO (FunPtr ((Ptr ()) -> (CLong -> (IO CInt))))})
{-# LINE 296 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 8 (val::(FunPtr ((Ptr ()) -> (CLong -> (IO CInt)))))})
{-# LINE 297 "./Text/JSON/YAJL.chs" #-}

parsedDouble :: Callback m (Double -> m Bool)
parsedDouble = callback wrapCallbackDouble
	(\ptr -> do {peekByteOff ptr 12 ::IO (FunPtr ((Ptr ()) -> (CDouble -> (IO CInt))))})
{-# LINE 301 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 12 (val::(FunPtr ((Ptr ()) -> (CDouble -> (IO CInt)))))})
{-# LINE 302 "./Text/JSON/YAJL.chs" #-}

-- | If 'parsedNumber' is set, it overrides 'parsedInteger' and 'parsedDouble'.
-- Registered functions for these callbacks will not receive any input until
-- 'parsedNumber' is unset.
--
-- If 'parsedNumber' is not set, but one of 'parsedInteger' or 'parsedDouble'
-- is set, then any values which cannot be represented by 'CLong' or 'CDouble'
-- will cause a parse error.
--
-- The 'B.ByteString' is in UTF-8.
parsedNumber :: Callback m (B.ByteString -> m Bool)
parsedNumber = callback wrapCallbackBytes'
	(\ptr -> do {peekByteOff ptr 16 ::IO (FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 315 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 16 (val::(FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 316 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedAttributeText', 'parsedAttributeBytes', or
-- 'parsedAttributeBuffer' may be set. If another of these callbacks is set,
-- it will unset the others.
parsedAttributeText :: Callback m (T.Text -> m Bool)
parsedAttributeText = callback wrapCallbackText
	(\ptr -> do {peekByteOff ptr 28 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 323 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 28 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 324 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedAttributeText', 'parsedAttributeBytes', or
-- 'parsedAttributeBuffer' may be set. If another of these callbacks is set,
-- it will unset the others.
--
-- The 'B.ByteString' is in UTF-8.
parsedAttributeBytes :: Callback m (B.ByteString -> m Bool)
parsedAttributeBytes = callback wrapCallbackBytes
	(\ptr -> do {peekByteOff ptr 28 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 333 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 28 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 334 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedAttributeText', 'parsedAttributeBytes', or
-- 'parsedAttributeBuffer' may be set. If another of these callbacks is set,
-- it will unset the others.
--
-- The buffer is in UTF-8.
parsedAttributeBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)
parsedAttributeBuffer = callback wrapCallbackBuffer
	(\ptr -> do {peekByteOff ptr 28 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 343 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 28 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 344 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedText', 'parsedBytes', or 'parsedBuffer' may be set.
-- If another of these callbacks is set, it will unset the others.
parsedText :: Callback m (T.Text -> m Bool)
parsedText = callback wrapCallbackText
	(\ptr -> do {peekByteOff ptr 20 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 350 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 20 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 351 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedText', 'parsedBytes', or 'parsedBuffer' may be set.
-- If another of these callbacks is set, it will unset the others.
--
-- The 'B.ByteString' is in UTF-8.
parsedBytes :: Callback m (B.ByteString -> m Bool)
parsedBytes = callback wrapCallbackBytes
	(\ptr -> do {peekByteOff ptr 20 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 359 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 20 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 360 "./Text/JSON/YAJL.chs" #-}

-- | Only one of 'parsedText', 'parsedBytes', or 'parsedBuffer' may be set.
-- If another of these callbacks is set, it will unset the others.
--
-- The buffer is in UTF-8.
parsedBuffer :: Callback m ((Ptr Word8, Integer) -> m Bool)
parsedBuffer = callback wrapCallbackBuffer
	(\ptr -> do {peekByteOff ptr 20 ::IO (FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt)))))})
{-# LINE 368 "./Text/JSON/YAJL.chs" #-}
	(\ptr val -> do {pokeByteOff ptr 20 (val::(FunPtr ((Ptr ()) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))))})
{-# LINE 369 "./Text/JSON/YAJL.chs" #-}

withParser :: Parser m -> (ParserHandle -> IO a) -> m a
withParser p io = parserFromIO p $ withParserIO p io

withParserIO :: Parser m -> (ParserHandle -> IO a) -> IO a
withParserIO p io = withForeignPtr (parserHandle p) $ io . ParserHandle

-- | Get the number of bytes consumed from the last input chunk.
-- 
-- Note that if using 'parseText' or 'parseLazyText', this corresponds to
-- UTF-8 bytes, /not/ characters.
-- 
-- If the most recent call to 'parseBytes', 'parseText', etc, returned
-- 'ParseFinished', this will indicate whether there are any un-parsed
-- bytes past the end of input.
-- 
-- If the most recent parse returned 'ParseError', this will indicate where
-- the error occured.
-- 
getBytesConsumed :: Parser m -> m Integer
getBytesConsumed p = withParser p $ \h ->
	toInteger `fmap` yajl_get_bytes_consumed h

parseImpl :: Parser m -> (ParserHandle -> IO CInt) -> m ParseStatus
parseImpl p io = parserFromIO p $ do
	writeIORef (parserErrorRef p) Nothing
	rc <- E.block $ withParserIO p io
	touchForeignPtr $ parserCallbacks p
	case rc of
		0 -> return ParseFinished
		1 -> do
			threw <- readIORef $ parserErrorRef p
			case threw of
				Nothing -> return ParseCancelled
				Just exc -> E.throwIO exc
		2 -> return ParseContinue
		3 -> ParseError `fmap` getParseError p
		_ -> return $ ParseError . T.pack $ "Unknown 'yajl_status': " ++ show rc

parseText :: Parser m -> T.Text -> m ParseStatus
parseText p = parseBytes p . TE.encodeUtf8

parseLazyText :: Parser m -> TL.Text -> m ParseStatus
parseLazyText p = parseText p . T.concat . TL.toChunks

-- | The input must be in UTF-8.
parseBytes :: Parser m -> B.ByteString -> m ParseStatus
parseBytes p bytes = parseImpl p $ \h ->
	BU.unsafeUseAsCStringLen bytes $ \(cstr, len) ->
	yajl_parse h (castPtr cstr) (fromIntegral len)

-- | The input must be in UTF-8.
parseLazyBytes :: Parser m -> BL.ByteString -> m ParseStatus
parseLazyBytes p = parseBytes p . B.concat . BL.toChunks

-- | The input must be in UTF-8.
parseBuffer :: Parser m -> (Ptr Word8, Integer) -> m ParseStatus
parseBuffer p (ptr, len) = parseImpl p $ \h ->
	yajl_parse h (castPtr ptr) (fromIntegral len)

-- | Clients should call this when no more input is available, to indicate
-- EOF.
parseComplete :: Parser m -> m ParseStatus
parseComplete p = parseImpl p yajl_parse_complete
{-# LINE 433 "./Text/JSON/YAJL.chs" #-}

getParseError :: Parser m -> IO T.Text
getParseError p = withParserIO p $ \h -> E.bracket
	(yajl_get_error h 0 nullPtr 0)
	(yajl_free_error h)
	(\bytes -> T.pack `fmap` peekCString (castPtr bytes))

data Generator s = Generator
	{ genHandle :: ForeignPtr GenHandle
	}

data GeneratorConfig = GeneratorConfig
	{ generatorBeautify :: Bool
	-- ^ Whether to generate indented, whitespaced output.
	
	, generatorIndent :: T.Text
	-- ^ How much to indent beautified output by. This is only used
	-- if 'generatorBeautify' is 'True'.
	}

-- | If an error is encountered when generating data, a 'GeneratorError'
-- will be thrown.
-- 
-- With the exception of 'MaximumDepthExceeded', this is usually due to
-- incorrect use of the library.
-- 
data GeneratorError
	= InvalidAttributeName
	| MaximumDepthExceeded
	| GeneratorInErrorState
	| GenerationComplete
	| InvalidNumber
	| NoBuffer
	| UnknownError Integer
	deriving (Show, Eq, Typeable)

instance E.Exception GeneratorError

newtype GenHandle = GenHandle (Ptr (GenHandle))
{-# LINE 472 "./Text/JSON/YAJL.chs" #-}
newtype GenConfig = GenConfig (Ptr (GenConfig))
{-# LINE 473 "./Text/JSON/YAJL.chs" #-}

-- | Create a new, empty generator with the given configuration.
-- 
newGenerator :: GeneratorConfig -> ST.ST s (Generator s)
newGenerator config = ST.unsafeIOToST $
	allocaBytes 8 $ \cConfig -> do
		cIndent <- marshalText $ generatorIndent config
	
		(\ptr val -> do {pokeByteOff ptr 0 (val::CUInt)}) cConfig $ cFromBool $ generatorBeautify config
		withForeignPtr cIndent $ (\ptr val -> do {pokeByteOff ptr 4 (val::(Ptr CChar))}) cConfig
	
		GenHandle handlePtr <- cGenAlloc (GenConfig cConfig) nullPtr
		touchForeignPtr cIndent
		handleFP <- newForeignPtr cGenFree handlePtr
		return $ Generator handleFP

marshalText :: T.Text -> IO (ForeignPtr CChar)
marshalText text =
	BU.unsafeUseAsCStringLen (TE.encodeUtf8 text) $ \(temp, len) ->
	mallocForeignPtrBytes (len + 1) >>= \fp ->
	withForeignPtr fp $ \array -> do
		copyArray array temp len
		poke (advancePtr array len) 0
		return fp

cGenAlloc :: GenConfig -> Ptr () -> IO (GenHandle)
cGenAlloc a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  cGenAlloc'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 502 "./Text/JSON/YAJL.chs" #-}

foreign import ccall "yajl/yajl_gen.h &yajl_gen_free"
	cGenFree :: FunPtr (Ptr GenHandle -> IO ())

withGenerator :: Generator s -> (GenHandle -> IO a) -> ST.ST s a
withGenerator gen io = ST.unsafeIOToST $ withForeignPtr (genHandle gen) $ io . GenHandle

-- | Retrieve the @NUL@-terminated byte buffer.
-- 
getBuffer :: Generator s -> ST.ST s B.ByteString
getBuffer gen =
	withGenerator gen $ \h ->
	alloca $ \bufPtr ->
	alloca $ \lenPtr -> do
	yajl_gen_get_buf h bufPtr lenPtr
	buf <- peek bufPtr
	len <- peek lenPtr
	-- TODO: check that len is < (maxBound :: Int)
	B.packCStringLen (castPtr buf, fromIntegral len)

-- | Clear the generator's output buffer. This does not change the state
-- of the generator.
-- 
clearBuffer :: Generator s -> ST.ST s ()
clearBuffer g = withGenerator g yajl_gen_clear
{-# LINE 527 "./Text/JSON/YAJL.chs" #-}

generateNull :: Generator s -> ST.ST s ()
generateNull g = generate' g yajl_gen_null
{-# LINE 530 "./Text/JSON/YAJL.chs" #-}

generateBoolean :: Generator s -> Bool -> ST.ST s ()
generateBoolean g x = generate' g $ \h ->
	yajl_gen_bool h (cFromBool x)

generateIntegral :: Integral a => Generator s -> a -> ST.ST s ()
generateIntegral g = generateNumber g . showBytes . toInteger

generateDouble :: Generator s -> Double -> ST.ST s ()
generateDouble g = generateNumber g . showBytes

generateNumber :: Generator s -> B.ByteString -> ST.ST s ()
generateNumber g bytes = generate' g $ \h ->
	BU.unsafeUseAsCStringLen bytes $ \(cstr, len) ->
	yajl_gen_number h (castPtr cstr) (fromIntegral len)

generateText :: Generator s -> T.Text -> ST.ST s ()
generateText g text = generate' g $ \h ->
	withUtf8 text $ \(utf8, len) ->
	yajl_gen_string h utf8 len

generateBeginArray :: Generator s -> ST.ST s ()
generateBeginArray g = generate' g yajl_gen_array_open
{-# LINE 553 "./Text/JSON/YAJL.chs" #-}

generateEndArray :: Generator s -> ST.ST s ()
generateEndArray g = generate' g yajl_gen_array_close
{-# LINE 556 "./Text/JSON/YAJL.chs" #-}

generateBeginObject :: Generator s -> ST.ST s ()
generateBeginObject g = generate' g yajl_gen_map_open
{-# LINE 559 "./Text/JSON/YAJL.chs" #-}

generateEndObject :: Generator s -> ST.ST s ()
generateEndObject g = generate' g yajl_gen_map_close
{-# LINE 562 "./Text/JSON/YAJL.chs" #-}

generate' :: Generator s -> (GenHandle -> IO CInt) -> ST.ST s ()
generate' g io = withGenerator g io >>= \rc -> case rc of
	0 -> return ()
	1 -> throwST InvalidAttributeName
	2 -> throwST MaximumDepthExceeded
	3 -> throwST GeneratorInErrorState
	4 -> throwST GenerationComplete
	5 -> throwST InvalidNumber
	6 -> throwST NoBuffer
	_ -> throwST $ UnknownError $ toInteger rc

cFromBool :: Integral a => Bool -> a
cFromBool True = 1
cFromBool False = 0

cToBool :: CInt -> Bool
cToBool 1 = True
cToBool 0 = False
cToBool x = error $ "cToBool " ++ show x

withUtf8 :: T.Text -> ((Ptr CUChar, CUInt) -> IO a) -> IO a
withUtf8 text io =
	let bytes = TE.encodeUtf8 text in
	BU.unsafeUseAsCStringLen bytes $ \(cstr, len) ->
	io (castPtr cstr, fromIntegral len)

showBytes :: Show a => a -> B.ByteString
showBytes = BC.pack . show

throwST :: E.Exception e => e -> ST.ST s a
throwST = ST.unsafeIOToST . E.throwIO

foreign import ccall safe "Text/JSON/YAJL.chs.h memset"
  memset :: ((Ptr ()) -> (CInt -> (CUInt -> (IO (Ptr ())))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_alloc"
  yajl_alloc :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO (ParserHandle))))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_get_bytes_consumed"
  yajl_get_bytes_consumed :: ((ParserHandle) -> (IO CUInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_parse"
  yajl_parse :: ((ParserHandle) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_parse_complete"
  yajl_parse_complete :: ((ParserHandle) -> (IO CInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_get_error"
  yajl_get_error :: ((ParserHandle) -> (CInt -> ((Ptr CUChar) -> (CUInt -> (IO (Ptr CUChar))))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_free_error"
  yajl_free_error :: ((ParserHandle) -> ((Ptr CUChar) -> (IO ())))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_alloc"
  cGenAlloc'_ :: ((GenConfig) -> ((Ptr ()) -> (IO (GenHandle))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_get_buf"
  yajl_gen_get_buf :: ((GenHandle) -> ((Ptr (Ptr CUChar)) -> ((Ptr CUInt) -> (IO CInt))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_clear"
  yajl_gen_clear :: ((GenHandle) -> (IO ()))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_null"
  yajl_gen_null :: ((GenHandle) -> (IO CInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_bool"
  yajl_gen_bool :: ((GenHandle) -> (CInt -> (IO CInt)))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_number"
  yajl_gen_number :: ((GenHandle) -> ((Ptr CChar) -> (CUInt -> (IO CInt))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_string"
  yajl_gen_string :: ((GenHandle) -> ((Ptr CUChar) -> (CUInt -> (IO CInt))))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_array_open"
  yajl_gen_array_open :: ((GenHandle) -> (IO CInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_array_close"
  yajl_gen_array_close :: ((GenHandle) -> (IO CInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_map_open"
  yajl_gen_map_open :: ((GenHandle) -> (IO CInt))

foreign import ccall safe "Text/JSON/YAJL.chs.h yajl_gen_map_close"
  yajl_gen_map_close :: ((GenHandle) -> (IO CInt))