From b5de98423a131580650cfa251fefc0859c94e19a Mon Sep 17 00:00:00 2001 From: philopon Date: Fri, 7 Nov 2014 04:03:30 +0900 Subject: [PATCH 1/5] add find* getters. --- Text/XML/Pugi.hs | 15 ++++++++++++++ Text/XML/Pugi/Foreign/Node.hs | 36 ++++++++++++++++++++++++++++++++++ cbit/wrapper.cc | 37 +++++++++++++++++++++++++++++++++++ 3 files changed, 88 insertions(+) diff --git a/Text/XML/Pugi.hs b/Text/XML/Pugi.hs index ac62991..28f111f 100644 --- a/Text/XML/Pugi.hs +++ b/Text/XML/Pugi.hs @@ -220,6 +220,9 @@ class NodeLike n m where childValue :: HasChildren k => n k m -> M m S.ByteString childValueByName :: HasChildren k => S.ByteString -> n k m -> M m S.ByteString text :: n k m -> M m S.ByteString + findAttribute :: (S.ByteString -> S.ByteString -> Bool) -> n k m -> M m (Maybe Attribute) + findChild :: (Node -> Bool) -> n k m -> M m (Maybe (Node_ Unknown m)) + findNode :: (Node -> Bool) -> n k m -> M m (Maybe (Node_ Unknown m)) mapSibling :: (Node_ Unknown m -> a) -> n k m -> M m [a] mapAttrs :: HasAttribute k => (S.ByteString -> S.ByteString -> a) -> n k m -> M m [a] path :: Char -> n k m -> M m S.ByteString @@ -251,6 +254,9 @@ instance NodeLike Document_ Immutable where childValue = unsafeDupablePerformIO . N.childValue childValueByName n = unsafeDupablePerformIO . N.childValueByName n text = unsafeDupablePerformIO . N.text + findAttribute f = unsafeDupablePerformIO . N.findAttribute f + findChild f = unsafeDupablePerformIO . N.findChild f + findNode f = unsafeDupablePerformIO . N.findNode f mapSibling f = unsafeDupablePerformIO . N.mapSiblingM (return . f) mapAttrs f = unsafeDupablePerformIO . N.mapAttrsM (\k v -> return $ f k v) path c = unsafeDupablePerformIO . N.path c @@ -282,6 +288,9 @@ instance NodeLike Node_ Immutable where childValue = unsafeDupablePerformIO . N.childValue childValueByName n = unsafeDupablePerformIO . N.childValueByName n text = unsafeDupablePerformIO . N.text + findAttribute f = unsafeDupablePerformIO . N.findAttribute f + findChild f = unsafeDupablePerformIO . N.findChild f + findNode f = unsafeDupablePerformIO . N.findNode f mapSibling f = unsafeDupablePerformIO . N.mapSiblingM (return . f) mapAttrs f = unsafeDupablePerformIO . N.mapAttrsM (\k v -> return $ f k v) path c = unsafeDupablePerformIO . N.path c @@ -313,6 +322,9 @@ instance NodeLike Document_ Mutable where childValue = Modify . fmap Right . N.childValue childValueByName n = Modify . fmap Right . N.childValueByName n text = Modify . fmap Right . N.text + findAttribute f = Modify . fmap Right . N.findAttribute f + findChild f = Modify . fmap Right . N.findChild f + findNode f = Modify . fmap Right . N.findNode f mapSibling f = Modify . fmap Right . N.mapSiblingM (return . f) mapAttrs f = Modify . fmap Right . N.mapAttrsM (\k v -> return $ f k v) path c = Modify . fmap Right . N.path c @@ -344,6 +356,9 @@ instance NodeLike Node_ Mutable where childValue = Modify . fmap Right . N.childValue childValueByName n = Modify . fmap Right . N.childValueByName n text = Modify . fmap Right . N.text + findAttribute f = Modify . fmap Right . N.findAttribute f + findChild f = Modify . fmap Right . N.findChild f + findNode f = Modify . fmap Right . N.findNode f mapSibling f = Modify . fmap Right . N.mapSiblingM (return . f) mapAttrs f = Modify . fmap Right . N.mapAttrsM (\k v -> return $ f k v) path c = Modify . fmap Right . N.path c diff --git a/Text/XML/Pugi/Foreign/Node.hs b/Text/XML/Pugi/Foreign/Node.hs index 40b7dc8..d5fe985 100644 --- a/Text/XML/Pugi/Foreign/Node.hs +++ b/Text/XML/Pugi/Foreign/Node.hs @@ -62,6 +62,16 @@ type NodeMapper k m = Ptr (Node_ k m) -> IO () foreign import ccall unsafe "wrapper" wrap_node_mapper :: NodeMapper k m -> IO (FunPtr (NodeMapper k m)) foreign import ccall node_map_sibling :: Ptr n -> FunPtr (NodeMapper k m) -> IO () +type AttrPred = Ptr Attr -> IO CInt +foreign import ccall unsafe "wrapper" wrap_attr_pred :: AttrPred -> IO (FunPtr AttrPred) + +type NodePred = Ptr Node -> IO CInt +foreign import ccall unsafe "wrapper" wrap_node_pred :: NodePred -> IO (FunPtr NodePred) + +foreign import ccall find_attribute :: Ptr n -> FunPtr AttrPred -> IO (Ptr Attr) +foreign import ccall find_child :: Ptr n -> FunPtr NodePred -> IO (Ptr (Node_ k m)) +foreign import ccall find_node :: Ptr n -> FunPtr NodePred -> IO (Ptr (Node_ k m)) + type AttrMapper = Ptr Attr -> IO () foreign import ccall unsafe "wrapper" wrap_attr_mapper :: AttrMapper -> IO (FunPtr AttrMapper) foreign import ccall node_map_attributes :: Ptr n -> FunPtr AttrMapper -> IO () @@ -101,6 +111,19 @@ nodeCommon n f = withNode n $ \p -> do then return Nothing else Just . Node <$> newForeignPtr finalizerNode q +with_attr_pred :: (S.ByteString -> S.ByteString -> Bool) -> (FunPtr AttrPred -> IO a) -> IO a +with_attr_pred fn m = do + let func p = do + n <- S.packCString =<< attr_name p + v <- S.packCString =<< attr_value p + return . fromBool $ fn n v + bracket (wrap_attr_pred func) freeHaskellFunPtr m + +with_node_pred :: (Node -> Bool) -> (FunPtr NodePred -> IO a) -> IO a +with_node_pred fn m = + let func p = fromBool . fn . Node <$> newForeignPtr_ p + in bracket (wrap_node_pred func) freeHaskellFunPtr m + class NodeLike (n :: NodeKind -> MutableFlag -> *) where withNode :: n k m -> (Ptr (n k m) -> IO a) -> IO a @@ -167,6 +190,19 @@ class NodeLike (n :: NodeKind -> MutableFlag -> *) where text :: n k m -> IO S.ByteString text n = withNode n $ node_text >=> S.packCString + findAttribute :: (S.ByteString -> S.ByteString -> Bool) -> n k m -> IO (Maybe Attribute) + findAttribute f nd = withNode nd $ \n -> with_attr_pred f $ \a -> + bracket (find_attribute n a) delete_attr $ \attr -> + if attr == nullPtr + then return Nothing + else fmap Just $ (,) <$> (S.packCString =<< attr_name attr) <*> (S.packCString =<< attr_value attr) + + findChild :: (Node -> Bool) -> n k m -> IO (Maybe (Node_ Unknown m)) + findChild f nd = nodeCommon nd $ \n -> with_node_pred f $ find_child n + + findNode :: (Node -> Bool) -> n k m -> IO (Maybe (Node_ Unknown m)) + findNode f nd = nodeCommon nd $ \n -> with_node_pred f $ find_node n + mapSiblingM_ :: (Node_ Unknown m -> IO ()) -> n k m -> IO () mapSiblingM_ func n = withNode n $ \p -> do let f e = func . Node =<< newForeignPtr_ e diff --git a/cbit/wrapper.cc b/cbit/wrapper.cc index c13178a..eebf431 100644 --- a/cbit/wrapper.cc +++ b/cbit/wrapper.cc @@ -179,6 +179,43 @@ extern "C" { const char* node_child_value_by_name(const void* n, const char* name) { return static_cast(n)->child_value(name); } const char* node_text(const void* n) { return static_cast(n)->text().get(); } + typedef struct predicate { + bool (*attr_pred)(const Attr*); + bool (*node_pred)(const Node*); + + bool operator()(pugi::xml_attribute attr) const { + return attr_pred(&attr); + } + + bool operator()(pugi::xml_node node) const { + return node_pred(&node); + } + } predicate_t; + + bool default_attr_pred (const Attr*) { return true; } + bool default_node_pred (const Node*) { return true; } + + Attr* find_attribute(const void* node, bool(*attr_pred)(const Attr*)) { + predicate_t pred; + pred.attr_pred = attr_pred; + pred.node_pred = &default_node_pred; + return checkNewAttr(static_cast(node)->find_attribute(pred)); + } + + Node* find_child(const void* node, bool(node_pred)(const Node*)) { + predicate_t pred; + pred.attr_pred = default_attr_pred; + pred.node_pred = node_pred; + return checkNewNode(static_cast(node)->find_child(pred)); + } + + Node* find_node(const void* node, bool(node_pred)(const Node*)) { + predicate_t pred; + pred.attr_pred = default_attr_pred; + pred.node_pred = node_pred; + return checkNewNode(static_cast(node)->find_node(pred)); + } + void node_map_sibling (const void* node, void (*fun)(Node*)) { const Node* n = static_cast(node); for(pugi::xml_node_iterator it = n->begin(); it != n->end(); ++it) { From ec2f7091734c3b7c620b4c8bde1e0213139bb95d Mon Sep 17 00:00:00 2001 From: philopon Date: Sun, 9 Nov 2014 02:41:06 +0900 Subject: [PATCH 2/5] add Eq instance to Node and Document. remove unsafe in foreign import. --- Text/XML/Pugi.hs | 18 ++++- Text/XML/Pugi/Foreign/Attr.hs | 8 +-- Text/XML/Pugi/Foreign/Document.hs | 18 ++--- Text/XML/Pugi/Foreign/Node.hs | 103 +++++++++++++++------------- Text/XML/Pugi/Foreign/XPath.hs | 18 ++--- Text/XML/Pugi/Foreign/XPath/Node.hs | 8 +-- cbit/wrapper.cc | 2 + test/test.hs | 11 +++ 8 files changed, 111 insertions(+), 75 deletions(-) diff --git a/Text/XML/Pugi.hs b/Text/XML/Pugi.hs index 28f111f..d79376e 100644 --- a/Text/XML/Pugi.hs +++ b/Text/XML/Pugi.hs @@ -160,17 +160,24 @@ import Unsafe.Coerce parse :: D.ParseConfig -> S.ByteString -> Either D.ParseException Document -parse cfg str = unsafeDupablePerformIO $ D.parse cfg str +parse cfg str = unsafePerformIO $ D.parse cfg str +{-# NOINLINE parse #-} pretty :: D.PrettyConfig -> Document -> L.ByteString pretty cfg doc = unsafeDupablePerformIO $ D.pretty cfg doc -instance Show Node where +instance Show (Node_ k Immutable) where show = ("Node " ++) . L8.unpack . prettyNode def {D.prettyFlags = formatRaw} 0 -instance Show Document where +instance Show (Document_ k Immutable) where show = ("Document " ++) . L8.unpack . prettyNode def {D.prettyFlags = formatRaw} 0 +instance Eq (Node_ k Immutable) where + (==) = nodeEqual + +instance Eq (Document_ k Immutable) where + (==) = nodeEqual + -- | -- @ -- M Immutable a = a @@ -191,6 +198,7 @@ type instance M Mutable a = Modify a -- class NodeLike n m where asNode :: n k m -> M m (Node_ k m) + nodeEqual :: n k m -> n l o -> M m Bool forgetNodeKind :: n k m -> n Unknown m forgetNodeKind = unsafeCoerce {-# INLINE forgetNodeKind #-} @@ -234,6 +242,7 @@ class NodeLike n m where instance NodeLike Document_ Immutable where asNode = unsafeDupablePerformIO . N.asNode + nodeEqual a = unsafeDupablePerformIO . N.nodeEqual a prettyNode cfg dph = unsafeDupablePerformIO . N.prettyNode cfg dph hashValue = unsafeDupablePerformIO . N.hashValue nodeType = unsafeDupablePerformIO . N.nodeType @@ -268,6 +277,7 @@ instance NodeLike Document_ Immutable where instance NodeLike Node_ Immutable where asNode = unsafeDupablePerformIO . N.asNode + nodeEqual a = unsafeDupablePerformIO . N.nodeEqual a prettyNode cfg dph = unsafeDupablePerformIO . N.prettyNode cfg dph hashValue = unsafeDupablePerformIO . N.hashValue nodeType = unsafeDupablePerformIO . N.nodeType @@ -302,6 +312,7 @@ instance NodeLike Node_ Immutable where instance NodeLike Document_ Mutable where asNode = Modify . fmap Right . N.asNode + nodeEqual a = Modify . fmap Right . N.nodeEqual a prettyNode cfg dph = Modify . fmap Right . N.prettyNode cfg dph hashValue = Modify . fmap Right . N.hashValue nodeType = Modify . fmap Right . N.nodeType @@ -336,6 +347,7 @@ instance NodeLike Document_ Mutable where instance NodeLike Node_ Mutable where asNode = Modify . fmap Right . N.asNode + nodeEqual a = Modify . fmap Right . N.nodeEqual a prettyNode cfg dph = Modify . fmap Right . N.prettyNode cfg dph hashValue = Modify . fmap Right . N.hashValue nodeType = Modify . fmap Right . N.nodeType diff --git a/Text/XML/Pugi/Foreign/Attr.hs b/Text/XML/Pugi/Foreign/Attr.hs index e83a3f3..8c6c3f7 100644 --- a/Text/XML/Pugi/Foreign/Attr.hs +++ b/Text/XML/Pugi/Foreign/Attr.hs @@ -12,10 +12,10 @@ import qualified Data.ByteString as S import Text.XML.Pugi.Foreign.Types -- attr -foreign import ccall unsafe delete_attr :: Ptr Attr -> IO () -foreign import ccall unsafe attr_name :: Ptr Attr -> IO CString -foreign import ccall unsafe attr_value :: Ptr Attr -> IO CString -foreign import ccall unsafe attr_set_value :: Ptr Attr -> CString -> IO CInt +foreign import ccall delete_attr :: Ptr Attr -> IO () +foreign import ccall attr_name :: Ptr Attr -> IO CString +foreign import ccall attr_value :: Ptr Attr -> IO CString +foreign import ccall attr_set_value :: Ptr Attr -> CString -> IO CInt attrName, attrValue :: Ptr Attr -> IO S.ByteString attrName = attr_name >=> S.packCString diff --git a/Text/XML/Pugi/Foreign/Document.hs b/Text/XML/Pugi/Foreign/Document.hs index 0d75b2b..07abf47 100644 --- a/Text/XML/Pugi/Foreign/Document.hs +++ b/Text/XML/Pugi/Foreign/Document.hs @@ -23,10 +23,10 @@ import Text.XML.Pugi.Foreign.Types import Unsafe.Coerce -- Document -foreign import ccall unsafe new_document :: IO (Ptr MutableDocument) -foreign import ccall unsafe "&delete_document" finalizerDocument +foreign import ccall new_document :: IO (Ptr MutableDocument) +foreign import ccall "&delete_document" finalizerDocument :: FinalizerPtr (Document_ k m) -foreign import ccall unsafe reset_document_with :: Ptr MutableDocument -> Ptr (Document_ k m) -> IO () +foreign import ccall reset_document_with :: Ptr MutableDocument -> Ptr (Document_ k m) -> IO () freezeDocument :: Document_ k m -> Document freezeDocument = unsafeCoerce @@ -42,12 +42,12 @@ copyDocument (Document f) = withForeignPtr f $ \p -> do Document <$> newForeignPtr finalizerDocument d -- Parsing -foreign import ccall unsafe delete_parse_result :: ParseResult -> IO () -foreign import ccall unsafe parse_is_success :: ParseResult -> IO CInt -foreign import ccall unsafe parse_result_status :: ParseResult -> IO ParseStatus -foreign import ccall unsafe parse_result_offset :: ParseResult -> IO CLong -foreign import ccall unsafe parse_result_encoding :: ParseResult -> IO Encoding -foreign import ccall unsafe parse_result_description :: ParseResult -> IO CString +foreign import ccall delete_parse_result :: ParseResult -> IO () +foreign import ccall parse_is_success :: ParseResult -> IO CInt +foreign import ccall parse_result_status :: ParseResult -> IO ParseStatus +foreign import ccall parse_result_offset :: ParseResult -> IO CLong +foreign import ccall parse_result_encoding :: ParseResult -> IO Encoding +foreign import ccall parse_result_description :: ParseResult -> IO CString foreign import ccall load_buffer :: Ptr MutableDocument -> Ptr a -> CSize -> ParseFlags -> Encoding -> IO ParseResult foreign import ccall load_file :: Ptr MutableDocument -> CString -> ParseFlags -> Encoding -> IO ParseResult diff --git a/Text/XML/Pugi/Foreign/Node.hs b/Text/XML/Pugi/Foreign/Node.hs index d5fe985..6ea1d18 100644 --- a/Text/XML/Pugi/Foreign/Node.hs +++ b/Text/XML/Pugi/Foreign/Node.hs @@ -29,80 +29,88 @@ import Text.XML.Pugi.Foreign.Types import Text.XML.Pugi.Foreign.Attr -- node -foreign import ccall unsafe "&delete_node" finalizerNode +foreign import ccall "&delete_node" finalizerNode :: FinalizerPtr (Node_ k m) -foreign import ccall unsafe document_element :: Ptr (Document_ k m) -> IO (Ptr (Node_ k m)) +foreign import ccall document_element :: Ptr (Document_ k m) -> IO (Ptr (Node_ k m)) -foreign import ccall unsafe node_hash_value :: Ptr n -> IO CSize +foreign import ccall node_equal :: Ptr a -> Ptr b -> IO CInt -foreign import ccall unsafe node_type :: Ptr n -> IO NodeType +foreign import ccall node_hash_value :: Ptr n -> IO CSize -foreign import ccall unsafe node_name :: Ptr n -> IO CString -foreign import ccall unsafe node_value :: Ptr n -> IO CString +foreign import ccall node_type :: Ptr n -> IO NodeType -foreign import ccall unsafe node_parent :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_first_child :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_last_child :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_next_sibling :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_previous_sibling :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_name :: Ptr n -> IO CString +foreign import ccall node_value :: Ptr n -> IO CString -foreign import ccall unsafe node_child :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_attribute :: Ptr n -> CString -> IO (Ptr Attr) -foreign import ccall unsafe node_next_sibling_by_name :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_previous_sibling_by_name :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_find_child_by_name_and_attribute :: Ptr n -> CString -> CString -> CString -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_find_child_by_attribute :: Ptr n -> CString -> CString -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_parent :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_first_child :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_last_child :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_next_sibling :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_previous_sibling :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_child_value :: Ptr n -> IO CString -foreign import ccall unsafe node_child_value_by_name :: Ptr n -> CString -> IO CString -foreign import ccall unsafe node_text :: Ptr n -> IO CString +foreign import ccall node_child :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_attribute :: Ptr n -> CString -> IO (Ptr Attr) +foreign import ccall node_next_sibling_by_name :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_previous_sibling_by_name :: Ptr n -> CString -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_find_child_by_name_and_attribute :: Ptr n -> CString -> CString -> CString -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_find_child_by_attribute :: Ptr n -> CString -> CString -> IO (Ptr (Node_ Unknown a)) + +foreign import ccall node_child_value :: Ptr n -> IO CString +foreign import ccall node_child_value_by_name :: Ptr n -> CString -> IO CString +foreign import ccall node_text :: Ptr n -> IO CString type NodeMapper k m = Ptr (Node_ k m) -> IO () -foreign import ccall unsafe "wrapper" wrap_node_mapper :: NodeMapper k m -> IO (FunPtr (NodeMapper k m)) +foreign import ccall "wrapper" wrap_node_mapper :: NodeMapper k m -> IO (FunPtr (NodeMapper k m)) foreign import ccall node_map_sibling :: Ptr n -> FunPtr (NodeMapper k m) -> IO () type AttrPred = Ptr Attr -> IO CInt -foreign import ccall unsafe "wrapper" wrap_attr_pred :: AttrPred -> IO (FunPtr AttrPred) +foreign import ccall "wrapper" wrap_attr_pred :: AttrPred -> IO (FunPtr AttrPred) type NodePred = Ptr Node -> IO CInt -foreign import ccall unsafe "wrapper" wrap_node_pred :: NodePred -> IO (FunPtr NodePred) +foreign import ccall "wrapper" wrap_node_pred :: NodePred -> IO (FunPtr NodePred) foreign import ccall find_attribute :: Ptr n -> FunPtr AttrPred -> IO (Ptr Attr) foreign import ccall find_child :: Ptr n -> FunPtr NodePred -> IO (Ptr (Node_ k m)) foreign import ccall find_node :: Ptr n -> FunPtr NodePred -> IO (Ptr (Node_ k m)) +type BeginEnd m = Ptr (Node_ Unknown m) -> IO CInt +type ForEach m = CInt -> Ptr (Node_ Unknown m) -> IO CInt +foreign import ccall "wrapper" wrap_begin_end :: BeginEnd m -> IO (FunPtr (BeginEnd m)) +foreign import ccall "wrapper" wrap_for_each :: ForEach m -> IO (FunPtr (ForEach m)) +foreign import ccall node_traverse :: Ptr n -> FunPtr (BeginEnd m) -> FunPtr (ForEach m) -> FunPtr (BeginEnd m) -> IO CInt + type AttrMapper = Ptr Attr -> IO () -foreign import ccall unsafe "wrapper" wrap_attr_mapper :: AttrMapper -> IO (FunPtr AttrMapper) +foreign import ccall "wrapper" wrap_attr_mapper :: AttrMapper -> IO (FunPtr AttrMapper) foreign import ccall node_map_attributes :: Ptr n -> FunPtr AttrMapper -> IO () -foreign import ccall unsafe node_path :: Ptr n -> CChar -> IO CString -- must be free +foreign import ccall node_path :: Ptr n -> CChar -> IO CString -- must be free -foreign import ccall unsafe node_first_element_by_path :: Ptr n -> CString -> CChar -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_first_element_by_path :: Ptr n -> CString -> CChar -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe node_root :: Ptr n -> IO (Ptr (Node_ Unknown a)) +foreign import ccall node_root :: Ptr n -> IO (Ptr (Node_ Unknown a)) -foreign import ccall unsafe set_name :: Ptr n -> CString -> IO CInt -foreign import ccall unsafe set_value :: Ptr n -> CString -> IO CInt +foreign import ccall set_name :: Ptr n -> CString -> IO CInt +foreign import ccall set_value :: Ptr n -> CString -> IO CInt -foreign import ccall unsafe append_attribute :: Ptr n -> CString -> CString -> IO CInt -foreign import ccall unsafe prepend_attribute :: Ptr n -> CString -> CString -> IO CInt +foreign import ccall append_attribute :: Ptr n -> CString -> CString -> IO CInt +foreign import ccall prepend_attribute :: Ptr n -> CString -> CString -> IO CInt -foreign import ccall unsafe append_child :: Ptr n -> NodeType -> IO (Ptr (Node_ k a)) -foreign import ccall unsafe prepend_child :: Ptr n -> NodeType -> IO (Ptr (Node_ k a)) +foreign import ccall append_child :: Ptr n -> NodeType -> IO (Ptr (Node_ k a)) +foreign import ccall prepend_child :: Ptr n -> NodeType -> IO (Ptr (Node_ k a)) -foreign import ccall unsafe append_copy :: Ptr n -> Ptr (Node_ k a) -> IO (Ptr (Node_ k b)) -foreign import ccall unsafe prepend_copy :: Ptr n -> Ptr (Node_ k a) -> IO (Ptr (Node_ k b)) +foreign import ccall append_copy :: Ptr n -> Ptr (Node_ k a) -> IO (Ptr (Node_ k b)) +foreign import ccall prepend_copy :: Ptr n -> Ptr (Node_ k a) -> IO (Ptr (Node_ k b)) -foreign import ccall unsafe remove_attribute :: Ptr n -> CString -> IO CInt -foreign import ccall unsafe remove_child :: Ptr n -> Ptr (Node_ k a) -> IO CInt +foreign import ccall remove_attribute :: Ptr n -> CString -> IO CInt +foreign import ccall remove_child :: Ptr n -> Ptr (Node_ k a) -> IO CInt -foreign import ccall unsafe append_buffer :: Ptr n -> Ptr c -> CSize -> CUInt -> Encoding -> IO ParseResult +foreign import ccall append_buffer :: Ptr n -> Ptr c -> CSize -> CUInt -> Encoding -> IO ParseResult -foreign import ccall unsafe node_print :: Ptr n -> FunPtr Writer -> CString -> FormatFlags -> Encoding -> CUInt -> IO () +foreign import ccall node_print :: Ptr n -> FunPtr Writer -> CString -> FormatFlags -> Encoding -> CUInt -> IO () -foreign import ccall unsafe select_single_node :: Ptr n -> Ptr (XPath (NodeSet m)) -> IO (Ptr XNode) -foreign import ccall unsafe select_nodes :: Ptr n -> Ptr (XPath (NodeSet m)) -> IO (Ptr (NodeSet m)) +foreign import ccall select_single_node :: Ptr n -> Ptr (XPath (NodeSet m)) -> IO (Ptr XNode) +foreign import ccall select_nodes :: Ptr n -> Ptr (XPath (NodeSet m)) -> IO (Ptr (NodeSet m)) nodeCommon :: NodeLike n => n k m -> (Ptr (n k m) -> IO (Ptr (Node_ l m))) -> IO (Maybe (Node_ l m)) nodeCommon n f = withNode n $ \p -> do @@ -129,6 +137,9 @@ class NodeLike (n :: NodeKind -> MutableFlag -> *) where asNode :: n k m -> IO (Node_ k m) + nodeEqual :: n k m -> n l o -> IO Bool + nodeEqual a b = withNode a $ \p -> withNode b $ \q -> toBool <$> node_equal p q + hashValue :: n k m -> IO CSize hashValue n = withNode n node_hash_value nodeType :: n k m -> IO NodeType @@ -293,12 +304,12 @@ class NodeLike (n :: NodeKind -> MutableFlag -> *) where readIORef ref >>= \r -> return $ L.fromChunks (r []) -- xpath_node -foreign import ccall unsafe delete_xpath_node :: Ptr XNode -> IO () -foreign import ccall unsafe xpath_node_node :: Ptr XNode -> IO (Ptr (Node_ Unknown m)) -foreign import ccall unsafe xpath_node_attribute :: Ptr XNode -> IO (Ptr Attr) +foreign import ccall delete_xpath_node :: Ptr XNode -> IO () +foreign import ccall xpath_node_node :: Ptr XNode -> IO (Ptr (Node_ Unknown m)) +foreign import ccall xpath_node_attribute :: Ptr XNode -> IO (Ptr Attr) -foreign import ccall unsafe "&delete_xpath_node_set" finalizerXpathNodeSet :: FinalizerPtr (NodeSet m) -foreign import ccall unsafe xpath_node_set_size :: Ptr (NodeSet m) -> IO CSize +foreign import ccall "&delete_xpath_node_set" finalizerXpathNodeSet :: FinalizerPtr (NodeSet m) +foreign import ccall xpath_node_set_size :: Ptr (NodeSet m) -> IO CSize peekXNode :: Ptr XNode -> IO (XPathNode m) peekXNode p = do diff --git a/Text/XML/Pugi/Foreign/XPath.hs b/Text/XML/Pugi/Foreign/XPath.hs index 8e0c81d..0595e3d 100644 --- a/Text/XML/Pugi/Foreign/XPath.hs +++ b/Text/XML/Pugi/Foreign/XPath.hs @@ -22,17 +22,17 @@ import Text.XML.Pugi.Foreign.Types import Text.XML.Pugi.Foreign.Const import Text.XML.Pugi.Foreign.Node -foreign import ccall unsafe delete_xpath_query :: Ptr (XPath a) -> IO () -foreign import ccall unsafe "&delete_xpath_query" finalizerXpathQuery :: FinalizerPtr (XPath a) -foreign import ccall unsafe new_xpath_query_no_variable :: CString -> IO (Ptr (XPath a)) +foreign import ccall delete_xpath_query :: Ptr (XPath a) -> IO () +foreign import ccall "&delete_xpath_query" finalizerXpathQuery :: FinalizerPtr (XPath a) +foreign import ccall new_xpath_query_no_variable :: CString -> IO (Ptr (XPath a)) -foreign import ccall unsafe xpath_query_evaluate_boolean :: Ptr (XPath Bool) -> Ptr n -> IO CInt -foreign import ccall unsafe xpath_query_evaluate_number :: Ptr (XPath Double) -> Ptr n -> IO CDouble -foreign import ccall unsafe xpath_query_evaluate_string :: Ptr (XPath S.ByteString) -> Ptr n -> IO CString -foreign import ccall unsafe xpath_query_evaluate_node_set :: Ptr (XPath (NodeSet m)) -> Ptr n -> IO (Ptr (NodeSet m)) +foreign import ccall xpath_query_evaluate_boolean :: Ptr (XPath Bool) -> Ptr n -> IO CInt +foreign import ccall xpath_query_evaluate_number :: Ptr (XPath Double) -> Ptr n -> IO CDouble +foreign import ccall xpath_query_evaluate_string :: Ptr (XPath S.ByteString) -> Ptr n -> IO CString +foreign import ccall xpath_query_evaluate_node_set :: Ptr (XPath (NodeSet m)) -> Ptr n -> IO (Ptr (NodeSet m)) -foreign import ccall unsafe xpath_query_return_type :: Ptr (XPath a) -> IO XPathType -foreign import ccall unsafe xpath_query_parse_is_success :: Ptr (XPath a) -> IO CInt +foreign import ccall xpath_query_return_type :: Ptr (XPath a) -> IO XPathType +foreign import ccall xpath_query_parse_is_success :: Ptr (XPath a) -> IO CInt createXPath :: S.ByteString -> IO (XPath a) createXPath query = S.useAsCString query $ \c -> do diff --git a/Text/XML/Pugi/Foreign/XPath/Node.hs b/Text/XML/Pugi/Foreign/XPath/Node.hs index 187ae55..602f1c0 100644 --- a/Text/XML/Pugi/Foreign/XPath/Node.hs +++ b/Text/XML/Pugi/Foreign/XPath/Node.hs @@ -14,11 +14,11 @@ import Text.XML.Pugi.Foreign.Node import Data.IORef -foreign import ccall unsafe xpath_node_set_empty :: Ptr (NodeSet m) -> IO CInt -foreign import ccall unsafe xpath_node_set_index :: Ptr (NodeSet m) -> CSize -> IO (Ptr XNode) +foreign import ccall xpath_node_set_empty :: Ptr (NodeSet m) -> IO CInt +foreign import ccall xpath_node_set_index :: Ptr (NodeSet m) -> CSize -> IO (Ptr XNode) -foreign import ccall unsafe "wrapper" wrap_xpath_node_mapper :: (Ptr XNode -> IO ()) -> IO (FunPtr (Ptr XNode -> IO ())) -foreign import ccall xpath_node_set_map :: Ptr (NodeSet m) -> FunPtr (Ptr XNode -> IO ()) -> IO () +foreign import ccall "wrapper" wrap_xpath_node_mapper :: (Ptr XNode -> IO ()) -> IO (FunPtr (Ptr XNode -> IO ())) +foreign import ccall xpath_node_set_map :: Ptr (NodeSet m) -> FunPtr (Ptr XNode -> IO ()) -> IO () nodeSetSize :: NodeSet m -> Int nodeSetSize (NodeSet l _) = l diff --git a/cbit/wrapper.cc b/cbit/wrapper.cc index eebf431..16b6942 100644 --- a/cbit/wrapper.cc +++ b/cbit/wrapper.cc @@ -155,6 +155,8 @@ extern "C" { ////// methods of node void delete_node(const Node* n) { delete n; } + bool node_equal(const void* a, const void* b) { return *static_cast(a) == *static_cast(b); } + size_t node_hash_value(const void* n) { return static_cast(n)->hash_value(); } int node_type(const void* n) { return static_cast(n)->type(); } diff --git a/test/test.hs b/test/test.hs index 2f7b02a..03a8a8e 100644 --- a/test/test.hs +++ b/test/test.hs @@ -23,6 +23,7 @@ testA = either undefined id $ parse def { parseFlags = parseFull } testAStr tests :: TestTree tests = testGroup "Tests" [ parsePretty + , immutable ] parsePretty :: TestTree @@ -33,3 +34,13 @@ parsePretty = testGroup "Parse/Pretty" pp s = either undefined (pretty def {prettyFlags = formatRaw} ) $ parse def { parseFlags = parseFull } s +immutable :: TestTree +immutable = testGroup "Immutable" + [ immutableTestAFoo + ] + +immutableTestAFoo :: TestTree +immutableTestAFoo = testGroup "TestA/foo" + [ testCase "parent.child == id" $ Just node @?= (child "bar" node >>= parent) + ] + where Just node = child "foo" testA From f7d8e085c110d9b8418db6d3953d04226f1e61de Mon Sep 17 00:00:00 2001 From: philopon Date: Wed, 12 Nov 2014 00:04:46 +0900 Subject: [PATCH 3/5] add benchmark ghc-options. remove traverse ffi. --- Text/XML/Pugi/Foreign/Node.hs | 1 - pugixml.cabal | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/Text/XML/Pugi/Foreign/Node.hs b/Text/XML/Pugi/Foreign/Node.hs index 6ea1d18..8d9e925 100644 --- a/Text/XML/Pugi/Foreign/Node.hs +++ b/Text/XML/Pugi/Foreign/Node.hs @@ -78,7 +78,6 @@ type BeginEnd m = Ptr (Node_ Unknown m) -> IO CInt type ForEach m = CInt -> Ptr (Node_ Unknown m) -> IO CInt foreign import ccall "wrapper" wrap_begin_end :: BeginEnd m -> IO (FunPtr (BeginEnd m)) foreign import ccall "wrapper" wrap_for_each :: ForEach m -> IO (FunPtr (ForEach m)) -foreign import ccall node_traverse :: Ptr n -> FunPtr (BeginEnd m) -> FunPtr (ForEach m) -> FunPtr (BeginEnd m) -> IO CInt type AttrMapper = Ptr Attr -> IO () foreign import ccall "wrapper" wrap_attr_mapper :: AttrMapper -> IO (FunPtr AttrMapper) diff --git a/pugixml.cabal b/pugixml.cabal index a17466d..5da1676 100644 --- a/pugixml.cabal +++ b/pugixml.cabal @@ -46,5 +46,6 @@ test-suite test , tasty >=0.10 && <0.11 , tasty-hunit >=0.9 && <0.10 type: exitcode-stdio-1.0 + ghc-options: -Wall -O2 -threaded hs-source-dirs: test default-language: Haskell2010 From 4eaa00c937c4919352710add5e87987dba2d14c4 Mon Sep 17 00:00:00 2001 From: philopon Date: Wed, 12 Nov 2014 02:47:46 +0900 Subject: [PATCH 4/5] add some tests. --- test/test.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/test/test.hs b/test/test.hs index 03a8a8e..3db71ff 100644 --- a/test/test.hs +++ b/test/test.hs @@ -9,13 +9,12 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Text.XML.Pugi -import Data.Maybe main :: IO () main = defaultMain tests testAStr :: S.ByteString -testAStr = "quuxhoge]]>" +testAStr = "quuxhoge]]>" testA :: Document testA = either undefined id $ parse def { parseFlags = parseFull } testAStr @@ -42,5 +41,11 @@ immutable = testGroup "Immutable" immutableTestAFoo :: TestTree immutableTestAFoo = testGroup "TestA/foo" [ testCase "parent.child == id" $ Just node @?= (child "bar" node >>= parent) + , testCase "prevSibling.nextSibling == id" $ Just node @?= (nextSibling node >>= prevSibling) + , testCase "asNode == id" $ node @?= asNode node + , testCase "getName.firstChild == \"bar\"" $ (getName <$> firstChild node) @?= Just "bar" + , testCase "getName.lastChild == \"piyo\"" $ (getName <$> lastChild node) @?= Just "piyo" + , testCase "path == \"/foo\"" $ path '/' node @?= "/foo" + , testCase "root == parent" $ root node @?= parent node ] where Just node = child "foo" testA From 4e1c492eee78f9ea48e9d346d83873d1aec66739 Mon Sep 17 00:00:00 2001 From: philopon Date: Wed, 12 Nov 2014 02:56:05 +0900 Subject: [PATCH 5/5] add CHANGELOG. update documentation. version bumps. --- CHANGELOG.md | 4 ++++ Text/XML/Pugi.hs | 6 ++++++ pugixml.cabal | 4 ++-- 3 files changed, 12 insertions(+), 2 deletions(-) create mode 100644 CHANGELOG.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..559d4bd --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +0.2.0 +--- +* add Eq instance to Immutable Node, Document. +* add find by predicate functions(findAttribute, findChild, and findNode). diff --git a/Text/XML/Pugi.hs b/Text/XML/Pugi.hs index d79376e..ece7b57 100644 --- a/Text/XML/Pugi.hs +++ b/Text/XML/Pugi.hs @@ -228,8 +228,14 @@ class NodeLike n m where childValue :: HasChildren k => n k m -> M m S.ByteString childValueByName :: HasChildren k => S.ByteString -> n k m -> M m S.ByteString text :: n k m -> M m S.ByteString + + -- | find attribute by predicate. since v0.2.0. findAttribute :: (S.ByteString -> S.ByteString -> Bool) -> n k m -> M m (Maybe Attribute) + + -- | find child by predicate. since v0.2.0. findChild :: (Node -> Bool) -> n k m -> M m (Maybe (Node_ Unknown m)) + + -- | find node by predicate. since v0.2.0. findNode :: (Node -> Bool) -> n k m -> M m (Maybe (Node_ Unknown m)) mapSibling :: (Node_ Unknown m -> a) -> n k m -> M m [a] mapAttrs :: HasAttribute k => (S.ByteString -> S.ByteString -> a) -> n k m -> M m [a] diff --git a/pugixml.cabal b/pugixml.cabal index 5da1676..b169e47 100644 --- a/pugixml.cabal +++ b/pugixml.cabal @@ -1,7 +1,7 @@ name: pugixml -version: 0.1.0 +version: 0.2.0 synopsis: pugixml binding. -description: pugixml binding. +description: pugixml binding. example: license: MIT license-file: LICENSE author: HirotomoMoriwaki