{-# LANGUAGE RecordWildCards, BangPatterns #-}

-- | A module for fast first-approximation parsing of XML.
--   Note that entities, e.g. @&@, are not expanded.
module Text.XML.Hexml(
    Node, Attribute(..),
    parse, render,
    location, name, inner, outer,
    attributes, children, contents,
    attributeBy, childrenBy
    ) where

import Control.Applicative
import Control.Monad
import Data.Int
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal hiding (void)
import Foreign.ForeignPtr
import Foreign.Storable
import System.IO.Unsafe
import Data.Monoid
import Data.Tuple.Extra
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Internal as BS
import Prelude

data CDocument
data CNode
data CAttr

szAttr :: Int
szAttr = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Str -> Int
forall a. Storable a => a -> Int
sizeOf (Str
forall a. HasCallStack => a
undefined :: Str)
szNode :: Int
szNode = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Str -> Int
forall a. Storable a => a -> Int
sizeOf (Str
forall a. HasCallStack => a
undefined :: Str)


data Str = Str {Str -> Int32
strStart :: {-# UNPACK #-} !Int32, Str -> Int32
strLength :: {-# UNPACK #-} !Int32} deriving Int -> Str -> ShowS
[Str] -> ShowS
Str -> String
(Int -> Str -> ShowS)
-> (Str -> String) -> ([Str] -> ShowS) -> Show Str
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Str -> ShowS
showsPrec :: Int -> Str -> ShowS
$cshow :: Str -> String
show :: Str -> String
$cshowList :: [Str] -> ShowS
showList :: [Str] -> ShowS
Show

strEnd :: Str -> Int32
strEnd :: Str -> Int32
strEnd Str{Int32
strStart :: Str -> Int32
strLength :: Str -> Int32
strStart :: Int32
strLength :: Int32
..} = Int32
strStart Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
strLength

instance Storable Str where
    sizeOf :: Str -> Int
sizeOf Str
_ = Int
8
    alignment :: Str -> Int
alignment Str
_ = Int64 -> Int
forall a. Storable a => a -> Int
alignment (Int64
0 :: Int64)
    peek :: Ptr Str -> IO Str
peek Ptr Str
p = Int32 -> Int32 -> Str
Str (Int32 -> Int32 -> Str) -> IO Int32 -> IO (Int32 -> Str)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Str -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Str
p Int
0 IO (Int32 -> Str) -> IO Int32 -> IO Str
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Str -> Int -> IO Int32
forall b. Ptr b -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Str
p Int
4
    poke :: Ptr Str -> Str -> IO ()
poke Ptr Str
p Str{Int32
strStart :: Str -> Int32
strLength :: Str -> Int32
strStart :: Int32
strLength :: Int32
..} = Ptr Str -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Str
p Int
0 Int32
strStart IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Str -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Str
p Int
4 Int32
strLength

foreign import ccall hexml_document_parse :: CString -> CInt -> IO (Ptr CDocument)
foreign import ccall hexml_document_free :: Ptr CDocument -> IO ()
foreign import ccall "&hexml_document_free" hexml_document_free_funptr :: FunPtr (Ptr CDocument -> IO ())
foreign import ccall hexml_node_render :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO CInt
foreign import ccall unsafe hexml_document_error :: Ptr CDocument -> IO CString
foreign import ccall unsafe hexml_document_node :: Ptr CDocument -> IO (Ptr CNode)

foreign import ccall unsafe hexml_node_children :: Ptr CDocument -> Ptr CNode -> Ptr CInt -> IO (Ptr CNode)
foreign import ccall unsafe hexml_node_attributes :: Ptr CDocument -> Ptr CNode -> Ptr CInt -> IO (Ptr CAttr)

foreign import ccall unsafe hexml_node_child :: Ptr CDocument -> Ptr CNode -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
foreign import ccall unsafe hexml_node_attribute :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)

-- | A node in an XML document, created by 'parse', then calling functions such
--   as 'children' on that initial 'Node'.
data Node = Node BS.ByteString (ForeignPtr CDocument) (Ptr CNode)

-- | An XML attribute, comprising of a name and a value. As an example,
--   @hello=\"world\"@ would produce @Attribute \"hello\" \"world\"@.
data Attribute = Attribute
    {Attribute -> ByteString
attributeName :: BS.ByteString
    ,Attribute -> ByteString
attributeValue :: BS.ByteString
    } deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attribute -> ShowS
showsPrec :: Int -> Attribute -> ShowS
$cshow :: Attribute -> String
show :: Attribute -> String
$cshowList :: [Attribute] -> ShowS
showList :: [Attribute] -> ShowS
Show, Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
/= :: Attribute -> Attribute -> Bool
Eq, Eq Attribute
Eq Attribute =>
(Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Attribute -> Attribute -> Ordering
compare :: Attribute -> Attribute -> Ordering
$c< :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
>= :: Attribute -> Attribute -> Bool
$cmax :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
min :: Attribute -> Attribute -> Attribute
Ord)

instance Show Node where
    show :: Node -> String
show Node
d = String
"Node " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Node -> ByteString
outer Node
d)


touchBS :: BS.ByteString -> IO ()
touchBS :: ByteString -> IO ()
touchBS = ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (ForeignPtr Word8 -> IO ())
-> (ByteString -> ForeignPtr Word8) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignPtr Word8, Int, Int) -> ForeignPtr Word8
forall a b c. (a, b, c) -> a
fst3 ((ForeignPtr Word8, Int, Int) -> ForeignPtr Word8)
-> (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString
-> ForeignPtr Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ForeignPtr Word8, Int, Int)
BS.toForeignPtr


-- | Parse a ByteString as an XML document, returning a 'Left' error message, or a 'Right' document.
--   Note that the returned node will have a 'name' of @\"\"@, no 'attributes', and 'contents' as per the document.
--   Often the first child will be the @\<?xml ... ?\>@ element. For documents which comprise an XML node and a single
--   root element, use @'children' n !! 1@.
parse :: BS.ByteString -> Either BS.ByteString Node
parse :: ByteString -> Either ByteString Node
parse ByteString
src = do
    let src0 :: ByteString
src0 = ByteString
src ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS.singleton Char
'\0'
    IO (Either ByteString Node) -> Either ByteString Node
forall a. IO a -> a
unsafePerformIO (IO (Either ByteString Node) -> Either ByteString Node)
-> IO (Either ByteString Node) -> Either ByteString Node
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CStringLen -> IO (Either ByteString Node))
-> IO (Either ByteString Node)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
src0 ((CStringLen -> IO (Either ByteString Node))
 -> IO (Either ByteString Node))
-> (CStringLen -> IO (Either ByteString Node))
-> IO (Either ByteString Node)
forall a b. (a -> b) -> a -> b
$ \(CString
str, Int
len) -> do
        doc <- CString -> CInt -> IO (Ptr CDocument)
hexml_document_parse CString
str (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)
        err <- hexml_document_error doc
        if err /= nullPtr then do
            bs <- BS.packCString =<< hexml_document_error doc
            hexml_document_free doc
            pure $ Left bs
         else do
            node <- hexml_document_node doc
            doc <- newForeignPtr hexml_document_free_funptr doc
            pure $ Right $ Node src0 doc node

-- | Given a node, rerender it to something with an equivalent parse tree.
--   Mostly useful for debugging - if you want the real source document use 'outer' instead.
render :: Node -> BS.ByteString
render :: Node -> ByteString
render (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument
-> (Ptr CDocument -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO ByteString) -> IO ByteString)
-> (Ptr CDocument -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
d -> do
    i <- Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO CInt
hexml_node_render Ptr CDocument
d Ptr CNode
n CString
forall a. Ptr a
nullPtr CInt
0
    res <- BS.create (fromIntegral i) $ \Ptr Word8
ptr -> IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO CInt
hexml_node_render Ptr CDocument
d Ptr CNode
n (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) CInt
i
    touchBS src
    pure res

applyStr :: BS.ByteString -> Str -> BS.ByteString
applyStr :: ByteString -> Str -> ByteString
applyStr ByteString
bs Str{Int32
strStart :: Str -> Int32
strLength :: Str -> Int32
strStart :: Int32
strLength :: Int32
..} = Int -> ByteString -> ByteString
BS.take (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
strLength) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
strStart) ByteString
bs

nodeStr :: Int -> Node -> Str
nodeStr :: Int -> Node -> Str
nodeStr Int
i (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) = IO Str -> Str
forall a. IO a -> a
unsafePerformIO (IO Str -> Str) -> IO Str -> Str
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument -> (Ptr CDocument -> IO Str) -> IO Str
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO Str) -> IO Str)
-> (Ptr CDocument -> IO Str) -> IO Str
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
_ -> Ptr Str -> Int -> IO Str
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr CNode -> Ptr Str
forall a b. Ptr a -> Ptr b
castPtr Ptr CNode
n) Int
i

nodeBS :: Int -> Node -> BS.ByteString
nodeBS :: Int -> Node -> ByteString
nodeBS Int
i node :: Node
node@(Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) = ByteString -> Str -> ByteString
applyStr ByteString
src (Str -> ByteString) -> Str -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Node -> Str
nodeStr Int
i Node
node

attrPeek :: BS.ByteString -> ForeignPtr CDocument -> Ptr CAttr -> Attribute
attrPeek :: ByteString -> ForeignPtr CDocument -> Ptr CAttr -> Attribute
attrPeek ByteString
src ForeignPtr CDocument
doc Ptr CAttr
a = IO Attribute -> Attribute
forall a. IO a -> a
unsafePerformIO (IO Attribute -> Attribute) -> IO Attribute -> Attribute
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument
-> (Ptr CDocument -> IO Attribute) -> IO Attribute
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO Attribute) -> IO Attribute)
-> (Ptr CDocument -> IO Attribute) -> IO Attribute
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
_ -> do
    name <- ByteString -> Str -> ByteString
applyStr ByteString
src (Str -> ByteString) -> IO Str -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Str -> Int -> IO Str
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr CAttr -> Ptr Str
forall a b. Ptr a -> Ptr b
castPtr Ptr CAttr
a) Int
0
    val  <- applyStr src <$> peekElemOff (castPtr a) 1
    pure $ Attribute name val

-- | Get the name of a node, e.g. @\<test /\>@ produces @\"test\"@.
name :: Node -> BS.ByteString
name :: Node -> ByteString
name = Int -> Node -> ByteString
nodeBS Int
0

-- | Get the inner text, from inside the tag, e.g. @\<test /\>@ produces @\"\"@
--   and @\<test\>hello\</test\>@ produces @\"hello\"@.
--   The result will have identical layout/spacing to the source document.
inner :: Node -> BS.ByteString
inner :: Node -> ByteString
inner = Int -> Node -> ByteString
nodeBS Int
1

-- | Get the outer text, including the tag itself, e.g. @\<test /\>@ produces @\"\<test /\>\"@
--   and @\<test\>hello\</test\>@ produces @\"\<test\>hello\</test\>\"@.
--   The result will have identical layout/spacing to the source document.
outer :: Node -> BS.ByteString
outer :: Node -> ByteString
outer = Int -> Node -> ByteString
nodeBS Int
2

-- | Get the contents of a node, including both the content strings (as 'Left', never blank) and
--   the direct child nodes (as 'Right').
--   If you only want the child nodes, use 'children'.
contents :: Node -> [Either BS.ByteString Node]
contents :: Node -> [Either ByteString Node]
contents n :: Node
n@(Node ByteString
src ForeignPtr CDocument
_ Ptr CNode
_) = Int32 -> [(Str, Node)] -> [Either ByteString Node]
forall {b}. Int32 -> [(Str, b)] -> [Either ByteString b]
f (Str -> Int32
strStart Str
inner) [(Str, Node)]
outers
    where
        f :: Int32 -> [(Str, b)] -> [Either ByteString b]
f Int32
i [] = Int32 -> Int32 -> [Either ByteString b]
forall {b}. Int32 -> Int32 -> [Either ByteString b]
string Int32
i (Str -> Int32
strEnd Str
inner)
        f Int32
i ((Str
x, b
n):[(Str, b)]
xs) = Int32 -> Int32 -> [Either ByteString b]
forall {b}. Int32 -> Int32 -> [Either ByteString b]
string Int32
i (Str -> Int32
strStart Str
x) [Either ByteString b]
-> [Either ByteString b] -> [Either ByteString b]
forall a. [a] -> [a] -> [a]
++ b -> Either ByteString b
forall a b. b -> Either a b
Right b
n Either ByteString b
-> [Either ByteString b] -> [Either ByteString b]
forall a. a -> [a] -> [a]
: Int32 -> [(Str, b)] -> [Either ByteString b]
f (Str -> Int32
strEnd Str
x) [(Str, b)]
xs

        string :: Int32 -> Int32 -> [Either ByteString b]
string Int32
start Int32
end | Int32
start Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
end = []
                         | Bool
otherwise = [ByteString -> Either ByteString b
forall a b. a -> Either a b
Left (ByteString -> Either ByteString b)
-> ByteString -> Either ByteString b
forall a b. (a -> b) -> a -> b
$ ByteString -> Str -> ByteString
applyStr ByteString
src (Str -> ByteString) -> Str -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Str
Str Int32
start (Int32
end Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
start)]
        inner :: Str
inner = Int -> Node -> Str
nodeStr Int
1 Node
n
        outers :: [(Str, Node)]
outers = (Node -> (Str, Node)) -> [Node] -> [(Str, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Node -> Str
nodeStr Int
2 (Node -> Str) -> (Node -> Node) -> Node -> (Str, Node)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& Node -> Node
forall a. a -> a
id) ([Node] -> [(Str, Node)]) -> [Node] -> [(Str, Node)]
forall a b. (a -> b) -> a -> b
$ Node -> [Node]
children Node
n

-- | Get the direct child nodes of this node.
children :: Node -> [Node]
children :: Node -> [Node]
children (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) = IO [Node] -> [Node]
forall a. IO a -> a
unsafePerformIO (IO [Node] -> [Node]) -> IO [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument -> (Ptr CDocument -> IO [Node]) -> IO [Node]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO [Node]) -> IO [Node])
-> (Ptr CDocument -> IO [Node]) -> IO [Node]
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
d ->
    (Ptr CInt -> IO [Node]) -> IO [Node]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [Node]) -> IO [Node])
-> (Ptr CInt -> IO [Node]) -> IO [Node]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
count -> do
        res <- Ptr CDocument -> Ptr CNode -> Ptr CInt -> IO (Ptr CNode)
hexml_node_children Ptr CDocument
d Ptr CNode
n Ptr CInt
count
        count <- fromIntegral <$> peek count
        pure [Node src doc $ plusPtr res $ i*szNode | i <- [0..count-1]]

-- | Get the attributes of this node.
attributes :: Node -> [Attribute]
attributes :: Node -> [Attribute]
attributes (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) = IO [Attribute] -> [Attribute]
forall a. IO a -> a
unsafePerformIO (IO [Attribute] -> [Attribute]) -> IO [Attribute] -> [Attribute]
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument
-> (Ptr CDocument -> IO [Attribute]) -> IO [Attribute]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO [Attribute]) -> IO [Attribute])
-> (Ptr CDocument -> IO [Attribute]) -> IO [Attribute]
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
d ->
    (Ptr CInt -> IO [Attribute]) -> IO [Attribute]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO [Attribute]) -> IO [Attribute])
-> (Ptr CInt -> IO [Attribute]) -> IO [Attribute]
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
count -> do
        res <- Ptr CDocument -> Ptr CNode -> Ptr CInt -> IO (Ptr CAttr)
hexml_node_attributes Ptr CDocument
d Ptr CNode
n Ptr CInt
count
        count <- fromIntegral <$> peek count
        pure [attrPeek src doc $ plusPtr res $ i*szAttr | i <- [0..count-1]]

-- | Get the direct children of this node which have a specific name.
--   A more efficient version of:
--
-- > childrenBy p s = filter (\n -> name n == s) $ children p
childrenBy :: Node -> BS.ByteString -> [Node]
childrenBy :: Node -> ByteString -> [Node]
childrenBy (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) ByteString
str = Ptr CNode -> [Node]
go Ptr CNode
forall a. Ptr a
nullPtr
    where
        go :: Ptr CNode -> [Node]
go Ptr CNode
old = IO [Node] -> [Node]
forall a. IO a -> a
unsafePerformIO (IO [Node] -> [Node]) -> IO [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument -> (Ptr CDocument -> IO [Node]) -> IO [Node]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO [Node]) -> IO [Node])
-> (Ptr CDocument -> IO [Node]) -> IO [Node]
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
d ->
            ByteString -> (CStringLen -> IO [Node]) -> IO [Node]
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
str ((CStringLen -> IO [Node]) -> IO [Node])
-> (CStringLen -> IO [Node]) -> IO [Node]
forall a b. (a -> b) -> a -> b
$ \(CString
bs, Int
len) -> do
                r <- Ptr CDocument
-> Ptr CNode -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
hexml_node_child Ptr CDocument
d Ptr CNode
n Ptr CNode
old CString
bs (CInt -> IO (Ptr CNode)) -> CInt -> IO (Ptr CNode)
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
                touchBS src
                pure $ if r == nullPtr then [] else Node src doc r : go r

-- | Get the first attribute of this node which has a specific name, if there is one.
--   A more efficient version of:
--
-- > attributeBy n s = listToMaybe $ filter (\(Attribute a _) -> a == s $ attributes n
attributeBy :: Node -> BS.ByteString -> Maybe Attribute
attributeBy :: Node -> ByteString -> Maybe Attribute
attributeBy (Node ByteString
src ForeignPtr CDocument
doc Ptr CNode
n) ByteString
str = IO (Maybe Attribute) -> Maybe Attribute
forall a. IO a -> a
unsafePerformIO (IO (Maybe Attribute) -> Maybe Attribute)
-> IO (Maybe Attribute) -> Maybe Attribute
forall a b. (a -> b) -> a -> b
$ ForeignPtr CDocument
-> (Ptr CDocument -> IO (Maybe Attribute)) -> IO (Maybe Attribute)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CDocument
doc ((Ptr CDocument -> IO (Maybe Attribute)) -> IO (Maybe Attribute))
-> (Ptr CDocument -> IO (Maybe Attribute)) -> IO (Maybe Attribute)
forall a b. (a -> b) -> a -> b
$ \Ptr CDocument
d ->
    ByteString
-> (CStringLen -> IO (Maybe Attribute)) -> IO (Maybe Attribute)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
str ((CStringLen -> IO (Maybe Attribute)) -> IO (Maybe Attribute))
-> (CStringLen -> IO (Maybe Attribute)) -> IO (Maybe Attribute)
forall a b. (a -> b) -> a -> b
$ \(CString
bs, Int
len) -> do
        r <- Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)
hexml_node_attribute Ptr CDocument
d Ptr CNode
n CString
bs (CInt -> IO (Ptr CAttr)) -> CInt -> IO (Ptr CAttr)
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
        touchBS src
        pure $ if r == nullPtr then Nothing else Just $ attrPeek src doc r

-- | Find the starting location of a node, the @<@ character.
--   The first character will be reported as @(line 1,column 1)@, because thats
--   how error messages typically do it.
location :: Node -> (Int, Int)
location :: Node -> (Int, Int)
location n :: Node
n@(Node ByteString
src ForeignPtr CDocument
_ Ptr CNode
_) = ((Int, Int) -> Char -> (Int, Int))
-> (Int, Int) -> ByteString -> (Int, Int)
forall a. (a -> Char -> a) -> a -> ByteString -> a
BS.foldl' (Int, Int) -> Char -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
f (Int -> Int -> (Int, Int)
forall {a} {b}. a -> b -> (a, b)
pair Int
1 Int
1) (ByteString -> (Int, Int)) -> ByteString -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) ByteString
src
    where
        pair :: a -> b -> (a, b)
pair !a
a !b
b = (a
a,b
b)

        i :: Int32
i = Str -> Int32
strStart (Str -> Int32) -> Str -> Int32
forall a b. (a -> b) -> a -> b
$ Int -> Node -> Str
nodeStr Int
2 Node
n
        f :: (a, b) -> Char -> (a, b)
f (!a
line, !b
col) Char
c
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = a -> b -> (a, b)
forall {a} {b}. a -> b -> (a, b)
pair (a
linea -> a -> a
forall a. Num a => a -> a -> a
+a
1) b
1
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = a -> b -> (a, b)
forall {a} {b}. a -> b -> (a, b)
pair a
line (b
colb -> b -> b
forall a. Num a => a -> a -> a
+b
8)
            | Bool
otherwise = a -> b -> (a, b)
forall {a} {b}. a -> b -> (a, b)
pair a
line (b
colb -> b -> b
forall a. Num a => a -> a -> a
+b
1)