@@ -1,9 +1,11 @@
1+{-# LANGUAGE RecordWildCards #-}
2module Text.XML.Hexml(
3module Text.XML.Hexml(
3 Document, Node, Attribute(..),
4 Document, Node, Attribute(..),
4 parse, render, rootNode,
5 parse, render, rootNode,
5− nodeInner, nodeOuter, nodeContents, nodeChildren, nodeAttributes,
6+ nodeName, nodeInner, nodeOuter,
7+ nodeAttributes, nodeChildren, nodeContents,
6− nodeChildrenBy, nodeAttributeBy
8+ nodeAttributeBy, nodeChildrenBy
9import Control.Monad
11import Control.Monad
@@ -11,6 +13,7 @@ import Data.Int
11import Foreign.C
13import Foreign.C
12import Foreign.Ptr
14import Foreign.Ptr
13import Foreign.ForeignPtr
15import Foreign.ForeignPtr
16+import Foreign.Storable
14import System.IO.Unsafe
17import System.IO.Unsafe
15import Data.Monoid
18import Data.Monoid
16import qualified Data.ByteString as BS
19import qualified Data.ByteString as BS
@@ -23,6 +26,12 @@ data CAttr
24data Str = Str {start :: {-# UNPACK #-} !Int32, length :: {-# UNPACK #-} !Int32}
27data Str = Str {start :: {-# UNPACK #-} !Int32, length :: {-# UNPACK #-} !Int32}
29+instance Storable Str where
31+ alignment _ = alignment (0 :: Int64)
32+ peek p = Str <$> peekByteOff p 0 <*> peekByteOff p 4
33+ poke p Str{..} = pokeByteOff p 0 start >> pokeByteOff p 4 length
26foreign import ccall document_parse :: CString -> CInt -> IO (Ptr CDocument)
35foreign import ccall document_parse :: CString -> CInt -> IO (Ptr CDocument)
27foreign import ccall document_free :: Ptr CDocument -> IO ()
36foreign import ccall document_free :: Ptr CDocument -> IO ()
28foreign import ccall "&document_free" document_free_funptr :: FunPtr (Ptr CDocument -> IO ())
37foreign import ccall "&document_free" document_free_funptr :: FunPtr (Ptr CDocument -> IO ())
@@ -30,6 +39,9 @@ foreign import ccall document_render :: Ptr CDocument -> CString -> CInt -> IO C
30foreign import ccall document_error :: Ptr CDocument -> IO CString
39foreign import ccall document_error :: Ptr CDocument -> IO CString
31foreign import ccall document_node :: Ptr CDocument -> IO (Ptr CNode)
40foreign import ccall document_node :: Ptr CDocument -> IO (Ptr CNode)
42+foreign import ccall node_children :: Ptr CDocument -> Ptr CNode -> Ptr CInt -> Ptr CNode
43+foreign import ccall node_attributes :: Ptr CDocument -> Ptr CNode -> Ptr CInt -> Ptr CAttr
33foreign import ccall node_firstChildBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
45foreign import ccall node_firstChildBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
34foreign import ccall node_nextChildBy :: Ptr CDocument -> Ptr CNode -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
46foreign import ccall node_nextChildBy :: Ptr CDocument -> Ptr CNode -> Ptr CNode -> CString -> CInt -> IO (Ptr CNode)
35foreign import ccall node_attributeBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)
47foreign import ccall node_attributeBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)
@@ -62,23 +74,33 @@ rootNode :: Document -> Node
62rootNode d@(Document src doc) = unsafePerformIO $ withForeignPtr doc $ \d -> do
74rootNode d@(Document src doc) = unsafePerformIO $ withForeignPtr doc $ \d -> do
63 Node src doc <$> document_node d
75 Node src doc <$> document_node d
77+applyStr :: BS.ByteString -> Str -> BS.ByteString
78+applyStr bs Str{..} = BS.take (fromIntegral length) $ BS.drop (fromIntegral start) bs
80+nodePeek :: Int -> Node -> BS.ByteString
81+nodePeek i (Node src doc n) = unsafePerformIO $ withForeignPtr doc $ \_ -> do
82+ applyStr src <$> peekElemOff (castPtr n) i
84+nodeName :: Node -> BS.ByteString
65nodeInner :: Node -> BS.ByteString
87nodeInner :: Node -> BS.ByteString
66−nodeInner (Node src doc i) = undefined
88+nodeInner = nodePeek 1
68nodeOuter :: Node -> BS.ByteString
90nodeOuter :: Node -> BS.ByteString
69−nodeOuter = undefined
91+nodeOuter = nodePeek 2
71nodeContents :: Node -> [Either Node BS.ByteString]
93nodeContents :: Node -> [Either Node BS.ByteString]
72nodeContents = undefined
94nodeContents = undefined
74nodeChildren :: Node -> [Node]
96nodeChildren :: Node -> [Node]
75−nodeChildren = undefined
97+nodeChildren = node_children `seq` undefined
77nodeAttributes :: Node -> [Attribute]
99nodeAttributes :: Node -> [Attribute]
78−nodeAttributes = undefined
100+nodeAttributes = node_attributes `seq` undefined
80nodeChildrenBy :: Node -> BS.ByteString -> [Node]
102nodeChildrenBy :: Node -> BS.ByteString -> [Node]
81−nodeChildrenBy = undefined
103+nodeChildrenBy = node_firstChildBy `seq` node_nextChildBy `seq` undefined
83nodeAttributeBy :: Node -> BS.ByteString -> Maybe Attribute
105nodeAttributeBy :: Node -> BS.ByteString -> Maybe Attribute
84−nodeAttributeBy = undefined
106+nodeAttributeBy = node_attributeBy `seq` undefined