{-# LINE 1 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module System.GLib.SimpleXmlSubsetParser (
	-- * TYPE
	GMarkupParseContext(..), mkGMarkupParseContext,

	-- * FUNCTION
	gMarkupParseContextParse,

	-- * G MARKUP ERROR
	pattern GErrorMarkup,
	pattern GMarkupErrorBadUtf8,
	pattern GMarkupErrorEmpty,
	pattern GMarkupErrorParse,
	pattern GMarkupErrorUnknownElement,
	pattern GMarkupErrorUnknownAttribute,
	pattern GMarkupErrorInvalidContent,
	pattern GMarkupErrorMissingAttribute
	) where

import Foreign.Ptr
import Foreign.ForeignPtr hiding (newForeignPtr)
import Foreign.Concurrent
import Foreign.Marshal
import Foreign.Storable
import Foreign.C.String
import Foreign.C.Enum
import Control.Monad.Primitive
import Data.Word
import Data.Int
import System.GLib.ErrorReporting
import System.GLib.Quarks.Internal

import System.IO.Unsafe

import qualified Data.Text as T
import qualified Data.Text.Foreign as T



newtype GMarkupParseContext s =
	GMarkupParseContext (ForeignPtr (GMarkupParseContext s)) deriving Int -> GMarkupParseContext s -> ShowS
forall s. Int -> GMarkupParseContext s -> ShowS
forall s. [GMarkupParseContext s] -> ShowS
forall s. GMarkupParseContext s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GMarkupParseContext s] -> ShowS
$cshowList :: forall s. [GMarkupParseContext s] -> ShowS
show :: GMarkupParseContext s -> String
$cshow :: forall s. GMarkupParseContext s -> String
showsPrec :: Int -> GMarkupParseContext s -> ShowS
$cshowsPrec :: forall s. Int -> GMarkupParseContext s -> ShowS
Show

mkGMarkupParseContext :: Ptr (GMarkupParseContext s) -> IO (GMarkupParseContext s)
mkGMarkupParseContext :: forall s. Ptr (GMarkupParseContext s) -> IO (GMarkupParseContext s)
mkGMarkupParseContext Ptr (GMarkupParseContext s)
p = forall s.
ForeignPtr (GMarkupParseContext s) -> GMarkupParseContext s
GMarkupParseContext
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr (GMarkupParseContext s)
p (forall s. Ptr (GMarkupParseContext s) -> IO ()
c_g_markup_parse_context_free Ptr (GMarkupParseContext s)
p)

foreign import ccall "g_markup_parse_context_free"
	c_g_markup_parse_context_free :: Ptr (GMarkupParseContext s) -> IO ()

gMarkupParseContextParse :: PrimMonad m =>
	GMarkupParseContext (PrimState m) -> T.Text -> m (Either GError ())
gMarkupParseContextParse :: forall (m :: * -> *).
PrimMonad m =>
GMarkupParseContext (PrimState m) -> Text -> m (Either GError ())
gMarkupParseContextParse (GMarkupParseContext ForeignPtr (GMarkupParseContext (PrimState m))
fpc) Text
t = forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim
	forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (GMarkupParseContext (PrimState m))
fpc \Ptr (GMarkupParseContext (PrimState m))
ppc -> forall a. Text -> (CStringLen -> IO a) -> IO a
T.withCStringLen Text
t \(Ptr CChar
ct, Int
ctl) -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (Ptr GError)
pge -> do
		Int32
r <- forall s.
Ptr (GMarkupParseContext s)
-> Ptr CChar -> Int64 -> Ptr (Ptr GError) -> IO Int32
c_g_markup_parse_context_parse Ptr (GMarkupParseContext (PrimState m))
ppc Ptr CChar
ct (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctl) Ptr (Ptr GError)
pge
		case Int32
r of
			Int32
0 -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr GError -> IO GError
mkGError forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
pge)
{-# LINE 61 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
			Int32
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
{-# LINE 62 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
			Int32
_ -> forall a. HasCallStack => String -> a
error String
"never occur"

foreign import ccall "g_markup_parse_context_parse"
	c_g_markup_parse_context_parse ::
	Ptr (GMarkupParseContext s) -> CString -> Int64 ->
{-# LINE 67 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	Ptr (Ptr GError) -> IO Int32
{-# LINE 68 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}

enum "GMarkupError" ''Word32 [''Show] [
{-# LINE 70 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorBadUtf8", 0),
{-# LINE 71 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorEmpty", 1),
{-# LINE 72 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorParse", 2),
{-# LINE 73 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorUnknownElement", 3),
{-# LINE 74 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorUnknownAttribute",
		4),
{-# LINE 76 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorInvalidContent", 5),
{-# LINE 77 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}
	("GMarkupErrorMissingAttribute",
		6) ]
{-# LINE 79 "src/System/GLib/SimpleXmlSubsetParser.hsc" #-}

pattern GErrorMarkup :: GMarkupError -> String -> GError
pattern $bGErrorMarkup :: GMarkupError -> String -> GError
$mGErrorMarkup :: forall {r}.
GError -> (GMarkupError -> String -> r) -> ((# #) -> r) -> r
GErrorMarkup c m <- (gErrorMarkup -> Just (c, m)) where
	GErrorMarkup (GMarkupError Word32
c) String
m =
		GQuark -> CInt -> String -> GError
GError GQuark
gMarkupErrorGQuark (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c) String
m

gErrorMarkup :: GError -> Maybe (GMarkupError, String)
gErrorMarkup :: GError -> Maybe (GMarkupError, String)
gErrorMarkup (GError GQuark
d CInt
c String
m)
	| GQuark
d forall a. Eq a => a -> a -> Bool
== GQuark
gMarkupErrorGQuark = forall a. a -> Maybe a
Just (Word32 -> GMarkupError
GMarkupError forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c, String
m)
	| Bool
otherwise = forall a. Maybe a
Nothing

gMarkupErrorGQuark :: GQuark
gMarkupErrorGQuark :: GQuark
gMarkupErrorGQuark = forall a. IO a -> a
unsafePerformIO IO GQuark
c_g_markup_error_quark

foreign import ccall "g_markup_error_quark" c_g_markup_error_quark :: IO GQuark