{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, CPP, ScopedTypeVariables, FlexibleInstances, GADTs #-}
{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}
module Text.XML.Expat.SAX (
Encoding(..),
XMLParseError(..),
XMLParseLocation(..),
ParseOptions(..),
SAXEvent(..),
parse,
parseG,
parseLocations,
parseLocationsG,
parseLocationsThrowing,
parseThrowing,
defaultParseOptions,
XMLParseException(..),
GenericXMLString(..)
) where
import Control.Concurrent.MVar
import Control.Exception as Exc
import Text.XML.Expat.Internal.IO
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Internal as I
import Data.Int
import Data.ByteString.Internal (c2w, w2c, c_strlen)
import qualified Data.Monoid as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Codec.Binary.UTF8.String as U8
import Data.List.Class (List(..), ListItem(..), cons, fromList, mapL)
import Data.Typeable
import Data.Word
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import System.IO.Unsafe
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
data ParseOptions tag text = ParseOptions
{ forall tag text. ParseOptions tag text -> Maybe Encoding
overrideEncoding :: Maybe Encoding
, forall tag text. ParseOptions tag text -> Maybe (tag -> Maybe text)
entityDecoder :: Maybe (tag -> Maybe text)
}
defaultParseOptions :: ParseOptions tag text
defaultParseOptions :: forall tag text. ParseOptions tag text
defaultParseOptions = Maybe Encoding
-> Maybe (tag -> Maybe text) -> ParseOptions tag text
forall tag text.
Maybe Encoding
-> Maybe (tag -> Maybe text) -> ParseOptions tag text
ParseOptions Maybe Encoding
forall a. Maybe a
Nothing Maybe (tag -> Maybe text)
forall a. Maybe a
Nothing
class (M.Monoid s, Eq s) => GenericXMLString s where
gxNullString :: s -> Bool
gxToString :: s -> String
gxFromString :: String -> s
gxFromChar :: Char -> s
gxHead :: s -> Char
gxTail :: s -> s
gxBreakOn :: Char -> s -> (s, s)
gxFromByteString :: B.ByteString -> s
gxToByteString :: s -> B.ByteString
instance GenericXMLString String where
gxNullString :: String -> Bool
gxNullString = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
gxToString :: String -> String
gxToString = String -> String
forall a. a -> a
id
gxFromString :: String -> String
gxFromString = String -> String
forall a. a -> a
id
gxFromChar :: Char -> String
gxFromChar Char
c = [Char
c]
gxHead :: String -> Char
gxHead = String -> Char
forall a. HasCallStack => [a] -> a
head
gxTail :: String -> String
gxTail = String -> String
forall a. HasCallStack => [a] -> [a]
tail
gxBreakOn :: Char -> String -> (String, String)
gxBreakOn Char
c = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)
gxFromByteString :: ByteString -> String
gxFromByteString = [Word8] -> String
U8.decode ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
gxToByteString :: String -> ByteString
gxToByteString = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (String -> [Word8]) -> (String -> String) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
U8.encodeString
instance GenericXMLString B.ByteString where
gxNullString :: ByteString -> Bool
gxNullString = ByteString -> Bool
B.null
gxToString :: ByteString -> String
gxToString = String -> String
U8.decodeString (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
w2c ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
gxFromString :: String -> ByteString
gxFromString = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (String -> [Word8]) -> (String -> String) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
U8.encodeString
gxFromChar :: Char -> ByteString
gxFromChar = Word8 -> ByteString
B.singleton (Word8 -> ByteString) -> (Char -> Word8) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
gxHead :: ByteString -> Char
gxHead = Word8 -> Char
w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head
gxTail :: ByteString -> ByteString
gxTail = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail
gxBreakOn :: Char -> ByteString -> (ByteString, ByteString)
gxBreakOn Char
c = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
c)
gxFromByteString :: ByteString -> ByteString
gxFromByteString = ByteString -> ByteString
forall a. a -> a
id
gxToByteString :: ByteString -> ByteString
gxToByteString = ByteString -> ByteString
forall a. a -> a
id
instance GenericXMLString T.Text where
gxNullString :: Text -> Bool
gxNullString = Text -> Bool
T.null
gxToString :: Text -> String
gxToString = Text -> String
T.unpack
gxFromString :: String -> Text
gxFromString = String -> Text
T.pack
gxFromChar :: Char -> Text
gxFromChar = Char -> Text
T.singleton
gxHead :: Text -> Char
gxHead = HasCallStack => Text -> Char
Text -> Char
T.head
gxTail :: Text -> Text
gxTail = HasCallStack => Text -> Text
Text -> Text
T.tail
#if MIN_VERSION_text(0,11,0)
gxBreakOn :: Char -> Text -> (Text, Text)
gxBreakOn Char
c = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c)
#elif MIN_VERSION_text(0,10,0)
gxBreakOn c t = (T.takeWhile (/=c) t, T.dropWhile (/=c) t)
#else
gxBreakOn c = T.breakBy (==c)
#endif
gxFromByteString :: ByteString -> Text
gxFromByteString = ByteString -> Text
TE.decodeUtf8
gxToByteString :: Text -> ByteString
gxToByteString = Text -> ByteString
TE.encodeUtf8
data SAXEvent tag text =
XMLDeclaration text (Maybe text) (Maybe Bool) |
StartElement tag [(tag, text)] |
EndElement tag |
CharacterData text |
StartCData |
EndCData |
ProcessingInstruction text text |
text |
FailDocument XMLParseError
deriving (SAXEvent tag text -> SAXEvent tag text -> Bool
(SAXEvent tag text -> SAXEvent tag text -> Bool)
-> (SAXEvent tag text -> SAXEvent tag text -> Bool)
-> Eq (SAXEvent tag text)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall tag text.
(Eq tag, Eq text) =>
SAXEvent tag text -> SAXEvent tag text -> Bool
$c== :: forall tag text.
(Eq tag, Eq text) =>
SAXEvent tag text -> SAXEvent tag text -> Bool
== :: SAXEvent tag text -> SAXEvent tag text -> Bool
$c/= :: forall tag text.
(Eq tag, Eq text) =>
SAXEvent tag text -> SAXEvent tag text -> Bool
/= :: SAXEvent tag text -> SAXEvent tag text -> Bool
Eq, Int -> SAXEvent tag text -> String -> String
[SAXEvent tag text] -> String -> String
SAXEvent tag text -> String
(Int -> SAXEvent tag text -> String -> String)
-> (SAXEvent tag text -> String)
-> ([SAXEvent tag text] -> String -> String)
-> Show (SAXEvent tag text)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall tag text.
(Show tag, Show text) =>
Int -> SAXEvent tag text -> String -> String
forall tag text.
(Show tag, Show text) =>
[SAXEvent tag text] -> String -> String
forall tag text.
(Show tag, Show text) =>
SAXEvent tag text -> String
$cshowsPrec :: forall tag text.
(Show tag, Show text) =>
Int -> SAXEvent tag text -> String -> String
showsPrec :: Int -> SAXEvent tag text -> String -> String
$cshow :: forall tag text.
(Show tag, Show text) =>
SAXEvent tag text -> String
show :: SAXEvent tag text -> String
$cshowList :: forall tag text.
(Show tag, Show text) =>
[SAXEvent tag text] -> String -> String
showList :: [SAXEvent tag text] -> String -> String
Show)
instance (NFData tag, NFData text) => NFData (SAXEvent tag text) where
rnf :: SAXEvent tag text -> ()
rnf (XMLDeclaration text
ver Maybe text
mEnc Maybe Bool
mSD) = text -> ()
forall a. NFData a => a -> ()
rnf text
ver () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe text -> ()
forall a. NFData a => a -> ()
rnf Maybe text
mEnc () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Bool -> ()
forall a. NFData a => a -> ()
rnf Maybe Bool
mSD
rnf (StartElement tag
tag [(tag, text)]
atts) = tag -> ()
forall a. NFData a => a -> ()
rnf tag
tag () -> () -> ()
forall a b. a -> b -> b
`seq` [(tag, text)] -> ()
forall a. NFData a => a -> ()
rnf [(tag, text)]
atts
rnf (EndElement tag
tag) = tag -> ()
forall a. NFData a => a -> ()
rnf tag
tag
rnf (CharacterData text
text) = text -> ()
forall a. NFData a => a -> ()
rnf text
text
rnf SAXEvent tag text
StartCData = ()
rnf SAXEvent tag text
EndCData = ()
rnf (ProcessingInstruction text
target text
text) = text -> ()
forall a. NFData a => a -> ()
rnf text
target () -> () -> ()
forall a b. a -> b -> b
`seq` text -> ()
forall a. NFData a => a -> ()
rnf text
text
rnf (Comment text
text) = text -> ()
forall a. NFData a => a -> ()
rnf text
text
rnf (FailDocument XMLParseError
err) = XMLParseError -> ()
forall a. NFData a => a -> ()
rnf XMLParseError
err
parseG :: forall tag text l . (GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> l (SAXEvent tag text)
{-# NOINLINE parseG #-}
parseG :: forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text -> l ByteString -> l (SAXEvent tag text)
parseG ParseOptions tag text
opts l ByteString
inputBlocks = ((SAXEvent tag text, ()) -> ItemM l (SAXEvent tag text))
-> l (SAXEvent tag text, ()) -> l (SAXEvent tag text)
forall (l :: * -> *) a b. List l => (a -> ItemM l b) -> l a -> l b
mapL (SAXEvent tag text -> ItemM l (SAXEvent tag text)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (SAXEvent tag text -> ItemM l (SAXEvent tag text))
-> ((SAXEvent tag text, ()) -> SAXEvent tag text)
-> (SAXEvent tag text, ())
-> ItemM l (SAXEvent tag text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SAXEvent tag text, ()) -> SAXEvent tag text
forall a b. (a, b) -> a
fst) (l (SAXEvent tag text, ()) -> l (SAXEvent tag text))
-> l (SAXEvent tag text, ()) -> l (SAXEvent tag text)
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO ((), Int))
-> (IO XMLParseLocation -> IO ())
-> l (SAXEvent tag text, ())
forall a tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO (a, Int))
-> (IO XMLParseLocation -> IO a)
-> l (SAXEvent tag text, a)
parseImpl ParseOptions tag text
opts l ByteString
inputBlocks Bool
False Ptr Word8 -> Int -> IO ((), Int)
forall {m :: * -> *} {p} {b}. Monad m => p -> b -> m ((), b)
noExtra IO XMLParseLocation -> IO ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
failureA
where noExtra :: p -> b -> m ((), b)
noExtra p
_ b
offset = ((), b) -> m ((), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), b
offset)
failureA :: p -> m ()
failureA p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
parseLocationsG :: forall tag text l . (GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> l (SAXEvent tag text, XMLParseLocation)
{-# NOINLINE parseLocationsG #-}
parseLocationsG :: forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString -> l (SAXEvent tag text, XMLParseLocation)
parseLocationsG ParseOptions tag text
opts l ByteString
inputBlocks = ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO (XMLParseLocation, Int))
-> (IO XMLParseLocation -> IO XMLParseLocation)
-> l (SAXEvent tag text, XMLParseLocation)
forall a tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO (a, Int))
-> (IO XMLParseLocation -> IO a)
-> l (SAXEvent tag text, a)
parseImpl ParseOptions tag text
opts l ByteString
inputBlocks Bool
True Ptr Word8 -> Int -> IO (XMLParseLocation, Int)
forall {a}. Ptr a -> Int -> IO (XMLParseLocation, Int)
fetchLocation IO XMLParseLocation -> IO XMLParseLocation
forall a. a -> a
id
where
fetchLocation :: Ptr a -> Int -> IO (XMLParseLocation, Int)
fetchLocation Ptr a
pBuf Int
offset = do
[Int64
a, Int64
b, Int64
c, Int64
d] <- Int -> Ptr Int64 -> IO [Int64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 (Ptr a
pBuf Ptr a -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset :: Ptr Int64)
(XMLParseLocation, Int) -> IO (XMLParseLocation, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Int64 -> Int64 -> Int64 -> XMLParseLocation
XMLParseLocation Int64
a Int64
b Int64
c Int64
d, Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
parseImpl :: forall a tag text l . (GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO (a, Int))
-> (IO XMLParseLocation -> IO a)
-> l (SAXEvent tag text, a)
parseImpl :: forall a tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString
-> Bool
-> (Ptr Word8 -> Int -> IO (a, Int))
-> (IO XMLParseLocation -> IO a)
-> l (SAXEvent tag text, a)
parseImpl ParseOptions tag text
opts l ByteString
inputBlocks Bool
addLocations Ptr Word8 -> Int -> IO (a, Int)
extra IO XMLParseLocation -> IO a
failureA = l ByteString
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError))
-> MVar (Maybe (l (SAXEvent tag text, a)))
-> l (SAXEvent tag text, a)
runParser l ByteString
inputBlocks ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef
where
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse, IO XMLParseLocation
getLocation, MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef) = IO
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
forall a. IO a -> a
unsafePerformIO (IO
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a)))))
-> IO
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
forall a b. (a -> b) -> a -> b
$ do
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse, IO XMLParseLocation
getLocation) <- Maybe Encoding
-> Maybe (ByteString -> Maybe ByteString)
-> Bool
-> IO
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation)
hexpatNewParser
(ParseOptions tag text -> Maybe Encoding
forall tag text. ParseOptions tag text -> Maybe Encoding
overrideEncoding ParseOptions tag text
opts)
((\tag -> Maybe text
decode -> (text -> ByteString) -> Maybe text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString (Maybe text -> Maybe ByteString)
-> (ByteString -> Maybe text) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tag -> Maybe text
decode (tag -> Maybe text)
-> (ByteString -> tag) -> ByteString -> Maybe text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> tag
forall s. GenericXMLString s => ByteString -> s
gxFromByteString) ((tag -> Maybe text) -> ByteString -> Maybe ByteString)
-> Maybe (tag -> Maybe text)
-> Maybe (ByteString -> Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseOptions tag text -> Maybe (tag -> Maybe text)
forall tag text. ParseOptions tag text -> Maybe (tag -> Maybe text)
entityDecoder ParseOptions tag text
opts)
Bool
addLocations
MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef <- Maybe (l (SAXEvent tag text, a))
-> IO (MVar (Maybe (l (SAXEvent tag text, a))))
forall a. a -> IO (MVar a)
newMVar Maybe (l (SAXEvent tag text, a))
forall a. Maybe a
Nothing
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
-> IO
(ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError),
IO XMLParseLocation, MVar (Maybe (l (SAXEvent tag text, a))))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse, IO XMLParseLocation
getLocation, MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef)
runParser :: l ByteString
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError))
-> MVar (Maybe (l (SAXEvent tag text, a)))
-> l (SAXEvent tag text, a)
runParser l ByteString
iblks ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef = ItemM l (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a)
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM l (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a))
-> ItemM l (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a)
forall a b. (a -> b) -> a -> b
$ do
ListItem l ByteString
li <- l ByteString -> ItemM l (ListItem l ByteString)
forall a. l a -> ItemM l (ListItem l a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList l ByteString
iblks
l (SAXEvent tag text, a) -> ItemM l (l (SAXEvent tag text, a))
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (SAXEvent tag text, a) -> ItemM l (l (SAXEvent tag text, a)))
-> l (SAXEvent tag text, a) -> ItemM l (l (SAXEvent tag text, a))
forall a b. (a -> b) -> a -> b
$ IO (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a)
forall a. IO a -> a
unsafePerformIO (IO (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a))
-> IO (l (SAXEvent tag text, a)) -> l (SAXEvent tag text, a)
forall a b. (a -> b) -> a -> b
$ do
Maybe (l (SAXEvent tag text, a))
mCached <- MVar (Maybe (l (SAXEvent tag text, a)))
-> IO (Maybe (l (SAXEvent tag text, a)))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef
case Maybe (l (SAXEvent tag text, a))
mCached of
Just l (SAXEvent tag text, a)
l -> do
MVar (Maybe (l (SAXEvent tag text, a)))
-> Maybe (l (SAXEvent tag text, a)) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef Maybe (l (SAXEvent tag text, a))
mCached
l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return l (SAXEvent tag text, a)
l
Maybe (l (SAXEvent tag text, a))
Nothing -> do
([(SAXEvent tag text, a)]
saxen, l (SAXEvent tag text, a)
rema) <- case ListItem l ByteString
li of
ListItem l ByteString
Nil -> do
(ForeignPtr Word8
buf, CInt
len, Maybe XMLParseError
mError) <- ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse ByteString
B.empty Bool
True
[(SAXEvent tag text, a)]
saxen <- ForeignPtr Word8
-> CInt
-> (Ptr Word8 -> Int -> IO (a, Int))
-> IO [(SAXEvent tag text, a)]
forall tag text a.
(GenericXMLString tag, GenericXMLString text) =>
ForeignPtr Word8
-> CInt
-> (Ptr Word8 -> Int -> IO (a, Int))
-> IO [(SAXEvent tag text, a)]
parseBuf ForeignPtr Word8
buf CInt
len Ptr Word8 -> Int -> IO (a, Int)
extra
l (SAXEvent tag text, a)
rema <- Maybe XMLParseError
-> l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
handleFailure Maybe XMLParseError
mError l (SAXEvent tag text, a)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
([(SAXEvent tag text, a)], l (SAXEvent tag text, a))
-> IO ([(SAXEvent tag text, a)], l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SAXEvent tag text, a)]
saxen, l (SAXEvent tag text, a)
rema)
Cons ByteString
blk l ByteString
t -> do
(ForeignPtr Word8
buf, CInt
len, Maybe XMLParseError
mError) <- ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse ByteString
blk Bool
False
[(SAXEvent tag text, a)]
saxen <- ForeignPtr Word8
-> CInt
-> (Ptr Word8 -> Int -> IO (a, Int))
-> IO [(SAXEvent tag text, a)]
forall tag text a.
(GenericXMLString tag, GenericXMLString text) =>
ForeignPtr Word8
-> CInt
-> (Ptr Word8 -> Int -> IO (a, Int))
-> IO [(SAXEvent tag text, a)]
parseBuf ForeignPtr Word8
buf CInt
len Ptr Word8 -> Int -> IO (a, Int)
extra
MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef' <- Maybe (l (SAXEvent tag text, a))
-> IO (MVar (Maybe (l (SAXEvent tag text, a))))
forall a. a -> IO (MVar a)
newMVar Maybe (l (SAXEvent tag text, a))
forall a. Maybe a
Nothing
l (SAXEvent tag text, a)
rema <- Maybe XMLParseError
-> l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
handleFailure Maybe XMLParseError
mError (l ByteString
-> (ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError))
-> MVar (Maybe (l (SAXEvent tag text, a)))
-> l (SAXEvent tag text, a)
runParser l ByteString
t ByteString
-> Bool -> IO (ForeignPtr Word8, CInt, Maybe XMLParseError)
parse MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef')
([(SAXEvent tag text, a)], l (SAXEvent tag text, a))
-> IO ([(SAXEvent tag text, a)], l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SAXEvent tag text, a)]
saxen, l (SAXEvent tag text, a)
rema)
let l :: l (SAXEvent tag text, a)
l = [(SAXEvent tag text, a)] -> l (SAXEvent tag text, a)
forall (l :: * -> *) a. List l => [a] -> l a
fromList [(SAXEvent tag text, a)]
saxen l (SAXEvent tag text, a)
-> l (SAXEvent tag text, a) -> l (SAXEvent tag text, a)
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` l (SAXEvent tag text, a)
rema
MVar (Maybe (l (SAXEvent tag text, a)))
-> Maybe (l (SAXEvent tag text, a)) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (l (SAXEvent tag text, a)))
cacheRef (l (SAXEvent tag text, a) -> Maybe (l (SAXEvent tag text, a))
forall a. a -> Maybe a
Just l (SAXEvent tag text, a)
l)
l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return l (SAXEvent tag text, a)
l
where
handleFailure :: Maybe XMLParseError
-> l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
handleFailure (Just XMLParseError
err) l (SAXEvent tag text, a)
_ = do a
a <- IO XMLParseLocation -> IO a
failureA IO XMLParseLocation
getLocation
l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a)))
-> l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
forall a b. (a -> b) -> a -> b
$ (XMLParseError -> SAXEvent tag text
forall tag text. XMLParseError -> SAXEvent tag text
FailDocument XMLParseError
err, a
a) (SAXEvent tag text, a)
-> l (SAXEvent tag text, a) -> l (SAXEvent tag text, a)
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` l (SAXEvent tag text, a)
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
handleFailure Maybe XMLParseError
Nothing l (SAXEvent tag text, a)
l = l (SAXEvent tag text, a) -> IO (l (SAXEvent tag text, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return l (SAXEvent tag text, a)
l
parseBuf :: (GenericXMLString tag, GenericXMLString text) =>
ForeignPtr Word8 -> CInt -> (Ptr Word8 -> Int -> IO (a, Int)) -> IO [(SAXEvent tag text, a)]
parseBuf :: forall tag text a.
(GenericXMLString tag, GenericXMLString text) =>
ForeignPtr Word8
-> CInt
-> (Ptr Word8 -> Int -> IO (a, Int))
-> IO [(SAXEvent tag text, a)]
parseBuf ForeignPtr Word8
buf CInt
_ Ptr Word8 -> Int -> IO (a, Int)
processExtra = ForeignPtr Word8
-> (Ptr Word8 -> IO [(SAXEvent tag text, a)])
-> IO [(SAXEvent tag text, a)]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO [(SAXEvent tag text, a)])
-> IO [(SAXEvent tag text, a)])
-> (Ptr Word8 -> IO [(SAXEvent tag text, a)])
-> IO [(SAXEvent tag text, a)]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pBuf -> [(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit [] Ptr Word8
pBuf Int
0
where
roundUp32 :: a -> a
roundUp32 a
offset = (a
offset a -> a -> a
forall a. Num a => a -> a -> a
+ a
3) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement a
3
doit :: [(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit [(SAXEvent tag text, a)]
acc Ptr Word8
pBuf Int
offset0 = Int
offset0 Int -> IO [(SAXEvent tag text, a)] -> IO [(SAXEvent tag text, a)]
forall a b. a -> b -> b
`seq` do
Word32
typ <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset0 :: Ptr Word32)
(a
a, Int
offset) <- Ptr Word8 -> Int -> IO (a, Int)
processExtra Ptr Word8
pBuf (Int
offset0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
case Word32
typ of
Word32
0 -> [(SAXEvent tag text, a)] -> IO [(SAXEvent tag text, a)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. [a] -> [a]
reverse [(SAXEvent tag text, a)]
acc)
Word32
1 -> do
Word32
nAtts <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset :: Ptr Word32)
let pName :: Ptr CChar
pName = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
Int
lName <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pName
let name :: tag
name = ByteString -> tag
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> tag) -> ByteString -> tag
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
lName
([(tag, text)]
atts, Int
offset') <- (([(tag, text)], Int) -> Word32 -> IO ([(tag, text)], Int))
-> ([(tag, text)], Int) -> [Word32] -> IO ([(tag, text)], Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([(tag, text)]
atts, Int
offset) Word32
_ -> do
let pAtt :: Ptr CChar
pAtt = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
Int
lAtt <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pAtt
let att :: tag
att = ByteString -> tag
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> tag) -> ByteString -> tag
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset Int
lAtt
offset' :: Int
offset' = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lAtt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
pValue :: Ptr CChar
pValue = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset'
Int
lValue <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pValue
let value :: text
value = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset' Int
lValue
([(tag, text)], Int) -> IO ([(tag, text)], Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((tag
att, text
value)(tag, text) -> [(tag, text)] -> [(tag, text)]
forall a. a -> [a] -> [a]
:[(tag, text)]
atts, Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
) ([], Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lName Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word32
1,Word32
3..Word32
nAtts]
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((tag -> [(tag, text)] -> SAXEvent tag text
forall tag text. tag -> [(tag, text)] -> SAXEvent tag text
StartElement tag
name ([(tag, text)] -> [(tag, text)]
forall a. [a] -> [a]
reverse [(tag, text)]
atts), a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 Int
offset')
Word32
2 -> do
let pName :: Ptr CChar
pName = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
Int
lName <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pName
let name :: tag
name = ByteString -> tag
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> tag) -> ByteString -> tag
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset Int
lName
offset' :: Int
offset' = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lName Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((tag -> SAXEvent tag text
forall tag text. tag -> SAXEvent tag text
EndElement tag
name, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 Int
offset')
Word32
3 -> do
Int
len <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset :: Ptr Word32)
let text :: text
text = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
len
offset' :: Int
offset' = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
CharacterData text
text, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 Int
offset')
Word32
4 -> do
let pEnc :: Ptr CChar
pEnc = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
Int
lEnc <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pEnc
let enc :: text
enc = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset Int
lEnc
offset' :: Int
offset' = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lEnc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
pVer :: Ptr Any
pVer = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset'
Word8
pVerFirst <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
pVer :: Ptr Word8)
(Maybe text
mVer, Int
offset'') <- case Word8
pVerFirst of
Word8
0 -> (Maybe text, Int) -> IO (Maybe text, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe text
forall a. Maybe a
Nothing, Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8
1 -> do
Int
lVer <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen (Ptr Any
pVer Ptr Any -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
(Maybe text, Int) -> IO (Maybe text, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (text -> Maybe text
forall a. a -> Maybe a
Just (text -> Maybe text) -> text -> Maybe text
forall a b. (a -> b) -> a -> b
$ ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf (Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
lVer, Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lVer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Word8
_ -> String -> IO (Maybe text, Int)
forall a. HasCallStack => String -> a
error String
"hexpat: bad data from C land"
Int8
cSta <- Ptr Int8 -> IO Int8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr Int8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset'' :: Ptr Int8)
let sta :: Maybe Bool
sta = if Int8
cSta Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
< Int8
0 then Maybe Bool
forall a. Maybe a
Nothing else
if Int8
cSta Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((text -> Maybe text -> Maybe Bool -> SAXEvent tag text
forall tag text.
text -> Maybe text -> Maybe Bool -> SAXEvent tag text
XMLDeclaration text
enc Maybe text
mVer Maybe Bool
sta, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 (Int
offset'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Word32
5 -> [(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((SAXEvent tag text
forall tag text. SAXEvent tag text
StartCData, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf Int
offset
Word32
6 -> [(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((SAXEvent tag text
forall tag text. SAXEvent tag text
EndCData, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf Int
offset
Word32
7 -> do
let pTarget :: Ptr CChar
pTarget = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
Int
lTarget <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pTarget
let target :: text
target = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset Int
lTarget
offset' :: Int
offset' = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lTarget Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
pData :: Ptr CChar
pData = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset'
Int
lData <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pData
let dat :: text
dat = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset' Int
lData
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((text -> text -> SAXEvent tag text
forall tag text. text -> text -> SAXEvent tag text
ProcessingInstruction text
target text
dat, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 (Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lData Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Word32
8 -> do
let pText :: Ptr CChar
pText = Ptr Word8
pBuf Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
Int
lText <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO CSize
c_strlen Ptr CChar
pText
let text :: text
text = ByteString -> text
forall s. GenericXMLString s => ByteString -> s
gxFromByteString (ByteString -> text) -> ByteString -> text
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
I.fromForeignPtr ForeignPtr Word8
buf Int
offset Int
lText
[(SAXEvent tag text, a)]
-> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
doit ((text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
Comment text
text, a
a) (SAXEvent tag text, a)
-> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
forall a. a -> [a] -> [a]
: [(SAXEvent tag text, a)]
acc) Ptr Word8
pBuf (Int -> Int
forall {a}. (Bits a, Num a) => a -> a
roundUp32 (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lText Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Word32
_ -> String -> IO [(SAXEvent tag text, a)]
forall a. HasCallStack => String -> a
error String
"hexpat: bad data from C land"
parse :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> [SAXEvent tag text]
parse :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> [SAXEvent tag text]
parse ParseOptions tag text
opts ByteString
input = ParseOptions tag text -> [ByteString] -> [SAXEvent tag text]
forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text -> l ByteString -> l (SAXEvent tag text)
parseG ParseOptions tag text
opts (ByteString -> [ByteString]
L.toChunks ByteString
input)
data XMLParseException = XMLParseException XMLParseError
deriving (XMLParseException -> XMLParseException -> Bool
(XMLParseException -> XMLParseException -> Bool)
-> (XMLParseException -> XMLParseException -> Bool)
-> Eq XMLParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XMLParseException -> XMLParseException -> Bool
== :: XMLParseException -> XMLParseException -> Bool
$c/= :: XMLParseException -> XMLParseException -> Bool
/= :: XMLParseException -> XMLParseException -> Bool
Eq, Int -> XMLParseException -> String -> String
[XMLParseException] -> String -> String
XMLParseException -> String
(Int -> XMLParseException -> String -> String)
-> (XMLParseException -> String)
-> ([XMLParseException] -> String -> String)
-> Show XMLParseException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> XMLParseException -> String -> String
showsPrec :: Int -> XMLParseException -> String -> String
$cshow :: XMLParseException -> String
show :: XMLParseException -> String
$cshowList :: [XMLParseException] -> String -> String
showList :: [XMLParseException] -> String -> String
Show, Typeable)
instance Exception XMLParseException where
parseLocations :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> [(SAXEvent tag text, XMLParseLocation)]
parseLocations :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
parseLocations ParseOptions tag text
opts ByteString
input = ParseOptions tag text
-> [ByteString] -> [(SAXEvent tag text, XMLParseLocation)]
forall tag text (l :: * -> *).
(GenericXMLString tag, GenericXMLString text, List l) =>
ParseOptions tag text
-> l ByteString -> l (SAXEvent tag text, XMLParseLocation)
parseLocationsG ParseOptions tag text
opts (ByteString -> [ByteString]
L.toChunks ByteString
input)
parseThrowing :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> [SAXEvent tag text]
parseThrowing :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> [SAXEvent tag text]
parseThrowing ParseOptions tag text
opts ByteString
bs = (SAXEvent tag text -> SAXEvent tag text)
-> [SAXEvent tag text] -> [SAXEvent tag text]
forall a b. (a -> b) -> [a] -> [b]
map SAXEvent tag text -> SAXEvent tag text
forall {tag} {text}. SAXEvent tag text -> SAXEvent tag text
freakOut ([SAXEvent tag text] -> [SAXEvent tag text])
-> [SAXEvent tag text] -> [SAXEvent tag text]
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text -> ByteString -> [SAXEvent tag text]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text -> ByteString -> [SAXEvent tag text]
parse ParseOptions tag text
opts ByteString
bs
where
freakOut :: SAXEvent tag text -> SAXEvent tag text
freakOut (FailDocument XMLParseError
err) = XMLParseException -> SAXEvent tag text
forall a e. Exception e => e -> a
Exc.throw (XMLParseException -> SAXEvent tag text)
-> XMLParseException -> SAXEvent tag text
forall a b. (a -> b) -> a -> b
$ XMLParseError -> XMLParseException
XMLParseException XMLParseError
err
freakOut SAXEvent tag text
other = SAXEvent tag text
other
parseLocationsThrowing :: (GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> L.ByteString
-> [(SAXEvent tag text, XMLParseLocation)]
parseLocationsThrowing :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
parseLocationsThrowing ParseOptions tag text
opts ByteString
bs = ((SAXEvent tag text, XMLParseLocation)
-> (SAXEvent tag text, XMLParseLocation))
-> [(SAXEvent tag text, XMLParseLocation)]
-> [(SAXEvent tag text, XMLParseLocation)]
forall a b. (a -> b) -> [a] -> [b]
map (SAXEvent tag text, XMLParseLocation)
-> (SAXEvent tag text, XMLParseLocation)
forall {tag} {text} {b}.
(SAXEvent tag text, b) -> (SAXEvent tag text, b)
freakOut ([(SAXEvent tag text, XMLParseLocation)]
-> [(SAXEvent tag text, XMLParseLocation)])
-> [(SAXEvent tag text, XMLParseLocation)]
-> [(SAXEvent tag text, XMLParseLocation)]
forall a b. (a -> b) -> a -> b
$ ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
parseLocations ParseOptions tag text
opts ByteString
bs
where
freakOut :: (SAXEvent tag text, b) -> (SAXEvent tag text, b)
freakOut (FailDocument XMLParseError
err, b
_) = XMLParseException -> (SAXEvent tag text, b)
forall a e. Exception e => e -> a
Exc.throw (XMLParseException -> (SAXEvent tag text, b))
-> XMLParseException -> (SAXEvent tag text, b)
forall a b. (a -> b) -> a -> b
$ XMLParseError -> XMLParseException
XMLParseException XMLParseError
err
freakOut (SAXEvent tag text, b)
other = (SAXEvent tag text, b)
other