{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, CPP, ScopedTypeVariables, FlexibleInstances, GADTs #-}
{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}

-- hexpat, a Haskell wrapper for expat
-- Copyright (C) 2008 Evan Martin <martine@danga.com>
-- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam>

-- | This module provides functions to parse an XML document to a lazy
-- stream of SAX events.
module Text.XML.Expat.SAX (
  -- * XML primitives
  Encoding(..),
  XMLParseError(..),
  XMLParseLocation(..),

  -- * SAX-style parse
  ParseOptions(..),
  SAXEvent(..),

  parse,
  parseG,
  parseLocations,
  parseLocationsG,
  parseLocationsThrowing,
  parseThrowing,
  defaultParseOptions,

  -- * Variants that throw exceptions
  XMLParseException(..),

  -- * Abstraction of string types
  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
          -- ^ The encoding parameter, if provided, overrides the document's
          -- encoding declaration.
    , forall tag text. ParseOptions tag text -> Maybe (tag -> Maybe text)
entityDecoder  :: Maybe (tag -> Maybe text)
          -- ^ If provided, entity references (i.e. @&nbsp;@ and friends) will
          -- be decoded into text using the supplied lookup function
    }

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


-- | An abstraction for any string type you want to use as xml text (that is,
-- attribute values or element text content). If you want to use a
-- new string type with /hexpat/, you must make it an instance of
-- 'GenericXMLString'.
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)
    -- breakBy gets renamed to break between 0.10.0.0 and 0.10.0.1.
    -- There's no 'break' function that is consistent between these two
    -- versions so we work around it using other functions.
    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 |
    Comment 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

-- | Parse a generalized list of ByteStrings containing XML to SAX events.
-- In the event of an error, FailDocument is the last element of the output list.
parseG :: forall tag text l . (GenericXMLString tag, GenericXMLString text, List l) =>
          ParseOptions tag text -- ^ Parse options
       -> l ByteString          -- ^ Input text (a lazy 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 ()

-- | Parse a generalized list of ByteStrings containing XML to SAX events.
-- In the event of an error, FailDocument is the last element of the output list.
parseLocationsG :: forall tag text l . (GenericXMLString tag, GenericXMLString text, List l) =>
                   ParseOptions tag text -- ^ Parse options
                -> l ByteString          -- ^ Input text (a lazy 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 -- ^ Parse options
          -> l ByteString          -- ^ Input text (a lazy ByteString)
          -> Bool                  -- ^ True to add locations to binary output
          -> (Ptr Word8 -> Int -> IO (a, Int)) -- ^ Fetch extra data
          -> (IO XMLParseLocation -> IO a)     -- ^ Fetch a value for failure case 
          -> 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 -> {-unsafeInterleaveIO $-} 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"

-- | Lazily parse XML to SAX events. In the event of an error, FailDocument is
-- the last element of the output list.
parse :: (GenericXMLString tag, GenericXMLString text) =>
         ParseOptions tag text  -- ^ Parse options
      -> L.ByteString           -- ^ Input text (a lazy 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)


-- | An exception indicating an XML parse error, used by the /..Throwing/ variants.
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

-- | A variant of parseSAX that gives a document location with each SAX event.
parseLocations :: (GenericXMLString tag, GenericXMLString text) =>
                  ParseOptions tag text  -- ^ Parse options
               -> L.ByteString            -- ^ Input text (a lazy 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)


-- | Lazily parse XML to SAX events. In the event of an error, throw
-- 'XMLParseException'.
--
-- @parseThrowing@ can throw an exception from pure code, which is generally a bad
-- way to handle errors, because Haskell\'s lazy evaluation means it\'s hard to
-- predict where it will be thrown from.  However, it may be acceptable in
-- situations where it's not expected during normal operation, depending on the
-- design of your program.
parseThrowing :: (GenericXMLString tag, GenericXMLString text) =>
                 ParseOptions tag text  -- ^ Parse options
              -> L.ByteString            -- ^ input text (a lazy 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


-- | A variant of parseSAX that gives a document location with each SAX event.
-- In the event of an error, throw 'XMLParseException'.
--
-- @parseLocationsThrowing@ can throw an exception from pure code, which is generally a bad
-- way to handle errors, because Haskell\'s lazy evaluation means it\'s hard to
-- predict where it will be thrown from.  However, it may be acceptable in
-- situations where it's not expected during normal operation, depending on the
-- design of your program.
parseLocationsThrowing :: (GenericXMLString tag, GenericXMLString text) =>
                          ParseOptions tag text  -- ^ Optional encoding override
                       -> L.ByteString            -- ^ Input text (a lazy 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