git.iko.soy/typeable/hexml
on master help sign in
Remove the idea of Document from the API at all, just use Node
025189dNeil Mitchell
src/Main.hs+7−7
compare with master
unifiedsplit
@@ -23,18 +23,18 @@ main :: IO ()
23main = do
23main = do
24 forM_ examples $ \(parses, src) -> do
24 forM_ examples $ \(parses, src) -> do
25 print src
25 print src
26− case documentParse src of
26+ case nodeParse src of
27 Left err -> when parses $ fail $ "Unexpected parse failure, " ++ show err
27 Left err -> when parses $ fail $ "Unexpected parse failure, " ++ show err
28 Right doc -> do
28 Right doc -> do
29 unless parses $ fail "Unexpected parse success"
29 unless parses $ fail "Unexpected parse success"
30− let r = documentRender doc
30+ let r = nodeRender doc
31 print r
31 print r
32 print $ rerender doc
32 print $ rerender doc
33 when (r /= rerender doc) $ fail "Different rerender"
33 when (r /= rerender doc) $ fail "Different rerender"
34− let Right d = documentParse r
34+ let Right d = nodeParse r
35− when (r /= documentRender d) $ fail "Different after rerendering"
35+ when (r /= nodeRender d) $ fail "Different after rerendering"
36
36
37− let Right doc = fmap documentNode $ documentParse "<test id=\"1\" extra=\"2\" /><test id=\"2\" /><b><test id=\"3\" /></b><test id=\"4\" /><test />"
37+ let Right doc = nodeParse "<test id=\"1\" extra=\"2\" /><test id=\"2\" /><b><test id=\"3\" /></b><test id=\"4\" /><test />"
38 map nodeName (nodeChildren doc) === ["test","test","b","test","test"]
38 map nodeName (nodeChildren doc) === ["test","test","b","test","test"]
39 length (nodeChildrenBy doc "test") === 4
39 length (nodeChildrenBy doc "test") === 4
40 length (nodeChildrenBy doc "b") === 1
40 length (nodeChildrenBy doc "b") === 1
@@ -45,8 +45,8 @@ main = do
45
45
46a === b = if a == b then putStrLn "success" else fail "mismatch"
46a === b = if a == b then putStrLn "success" else fail "mismatch"
47
47
48−rerender :: Document -> BS.ByteString
48+rerender :: Node -> BS.ByteString
49−rerender = contents . documentNode
49+rerender = contents
50 where
50 where
51 contents x = BS.concat $ map (either validStr node) $ nodeContents x
51 contents x = BS.concat $ map (either validStr node) $ nodeContents x
52 node x = "<" <> BS.unwords (validName (nodeName x) : map attr (nodeAttributes x)) <> ">" <>
52 node x = "<" <> BS.unwords (validName (nodeName x) : map attr (nodeAttributes x)) <> ">" <>
src/Text/XML/Hexml.hs+8−18
@@ -3,8 +3,8 @@
3-- | A module for first-approximation parsing of XML.
3-- | A module for first-approximation parsing of XML.
4-- Note that entities, e.g. @&amp;@, are not expanded.
4-- Note that entities, e.g. @&amp;@, are not expanded.
5module Text.XML.Hexml(
5module Text.XML.Hexml(
6− Document, Node, Attribute(..),
6+ Node, Attribute(..),
7− documentParse, documentRender, documentNode,
7+ nodeParse, nodeRender,
8 nodeName, nodeInner, nodeOuter,
8 nodeName, nodeInner, nodeOuter,
9 nodeAttributes, nodeChildren, nodeContents,
9 nodeAttributes, nodeChildren, nodeContents,
10 nodeAttributeBy, nodeChildrenBy
10 nodeAttributeBy, nodeChildrenBy
@@ -59,21 +59,16 @@ foreign import ccall node_childBy :: Ptr CDocument -> Ptr CNode -> Ptr CNode ->
59foreign import ccall node_attributeBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)
59foreign import ccall node_attributeBy :: Ptr CDocument -> Ptr CNode -> CString -> CInt -> IO (Ptr CAttr)
60
60
61-- | An XML document, created by 'documentParse'.
61-- | An XML document, created by 'documentParse'.
62−data Document = Document BS.ByteString (ForeignPtr CDocument)
63−
64data Node = Node BS.ByteString (ForeignPtr CDocument) (Ptr CNode)
62data Node = Node BS.ByteString (ForeignPtr CDocument) (Ptr CNode)
65
63
66data Attribute = Attribute BS.ByteString BS.ByteString deriving (Show, Eq, Ord)
64data Attribute = Attribute BS.ByteString BS.ByteString deriving (Show, Eq, Ord)
67
65
68−instance Show Document where
69− show d = "Document " ++ show (BS.unpack $ nodeOuter $ documentNode d)
70−
71instance Show Node where
66instance Show Node where
72 show d = "Node " ++ show (BS.unpack $ nodeOuter d)
67 show d = "Node " ++ show (BS.unpack $ nodeOuter d)
73
68
74
69
75−documentParse :: BS.ByteString -> Either BS.ByteString Document
70+nodeParse :: BS.ByteString -> Either BS.ByteString Node
76−documentParse src = unsafePerformIO $ BS.unsafeUseAsCStringLen (src <> BS.singleton '\0') $ \(str, len) -> do
71+nodeParse src = unsafePerformIO $ BS.unsafeUseAsCStringLen (src <> BS.singleton '\0') $ \(str, len) -> do
77 doc <- document_parse str (fromIntegral len - 1)
72 doc <- document_parse str (fromIntegral len - 1)
78 err <- document_error doc
73 err <- document_error doc
79 if err /= nullPtr then do
74 if err /= nullPtr then do
@@ -81,20 +76,15 @@ documentParse src = unsafePerformIO $ BS.unsafeUseAsCStringLen (src <> BS.single
81 document_free doc
76 document_free doc
82 return $ Left bs
77 return $ Left bs
83 else do
78 else do
79+ node <- document_node doc
84 doc <- newForeignPtr document_free_funptr doc
80 doc <- newForeignPtr document_free_funptr doc
85− return $ Right $ Document src doc
81+ return $ Right $ Node src doc node
86
82
87−documentRender :: Document -> BS.ByteString
83+nodeRender :: Node -> BS.ByteString
88−documentRender (Document _ doc) = unsafePerformIO $ withForeignPtr doc $ \d -> do
84+nodeRender (Node _ doc n) = unsafePerformIO $ withForeignPtr doc $ \d -> do
89− n <- document_node d
90 i <- node_render d n nullPtr 0
85 i <- node_render d n nullPtr 0
91 BS.create (fromIntegral i) $ \ptr -> void $ node_render d n (castPtr ptr) i
86 BS.create (fromIntegral i) $ \ptr -> void $ node_render d n (castPtr ptr) i
92
87
93−
94−documentNode :: Document -> Node
95−documentNode d@(Document src doc) = unsafePerformIO $ withForeignPtr doc $ \d -> do
96− Node src doc <$> document_node d
97−
98applyStr :: BS.ByteString -> Str -> BS.ByteString
88applyStr :: BS.ByteString -> Str -> BS.ByteString
99applyStr bs Str{..} = BS.take (fromIntegral strLength) $ BS.drop (fromIntegral strStart) bs
89applyStr bs Str{..} = BS.take (fromIntegral strLength) $ BS.drop (fromIntegral strStart) bs
100
90