Skip to content

Commit

Permalink
Merge branch 'develop'
Browse files Browse the repository at this point in the history
  • Loading branch information
@philopon
philopon committed Nov 11, 2014
2 parents 4f06c4e + 4e1c492 commit b972912
Show file tree
Hide file tree
Showing 10 changed files with 216 additions and 77 deletions.
4 changes: 4 additions & 0 deletions CHANGELOG.md
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
0.2.0
---
* add Eq instance to Immutable Node, Document.
* add find by predicate functions(findAttribute, findChild, and findNode).
39 changes: 36 additions & 3 deletions Text/XML/Pugi.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 #-}
Expand Down Expand Up @@ -220,6 +228,15 @@ 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]
path :: Char -> n k m -> M m S.ByteString
Expand All @@ -231,6 +248,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
Expand All @@ -251,6 +269,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
Expand All @@ -262,6 +283,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
Expand All @@ -282,6 +304,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
Expand All @@ -293,6 +318,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
Expand All @@ -313,6 +339,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
Expand All @@ -324,6 +353,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
Expand All @@ -344,6 +374,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
Expand Down
8 changes: 4 additions & 4 deletions Text/XML/Pugi/Foreign/Attr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
18 changes: 9 additions & 9 deletions Text/XML/Pugi/Foreign/Document.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
Loading

0 comments on commit b972912

Please sign in to comment.