module Text.XML.LibXML.Tree
( addChild
, newChild
, addSibling
, newNode
, newProperty
, newText
, newTextChild
, newDocument
, newDocumentPI
, documentDumpMemory
, newDocumentNode
, setDocumentRootElement
, getDocumentRootElement
) where
import Foreign.C
import Foreign
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import Data.ByteString (ByteString)
import Text.XML.LibXML.Types
import Text.XML.LibXML.Internals
foreign import ccall unsafe xmlAddChild :: Ptr Node -> Ptr Node -> IO (Ptr Node)
addChild :: MonadIO m => Node -> Node -> m ()
addChild parent cur
= liftIO $
withNode parent $ \parentPtr ->
withNode cur $ \curPtr ->
do ret <- xmlAddChild parentPtr curPtr
when (ret == nullPtr) $ error "Text.XML.LibXML.Tree.addChild: failed"
return ()
foreign import ccall unsafe xmlNewChild :: Ptr Node -> Ptr Namespace -> CString -> CString -> IO (Ptr Node)
newChild :: MonadIO m => Node -> Maybe Namespace -> String -> Maybe String -> m Node
newChild parent mbNs tag content
= liftIO $
withNode parent $ \parentPtr ->
maybeWith withNamespace mbNs $ \nsPtr ->
withCString tag $ \ctag ->
maybeWith withCString content $ \ccontent ->
mkFinalizedNode =<< xmlNewChild parentPtr nsPtr ctag ccontent
foreign import ccall unsafe xmlAddSibling :: Ptr Node -> Ptr Node -> IO (Ptr Node)
addSibling :: MonadIO m => Node -> Node -> m ()
addSibling parent cur
= liftIO $
withNode parent $ \parentPtr ->
withNode cur $ \curPtr ->
do xmlAddSibling parentPtr curPtr
return ()
foreign import ccall unsafe xmlNewNode :: Ptr Namespace -> CString -> IO (Ptr Node)
newNode :: MonadIO m => Maybe Namespace -> String -> m Node
newNode mbNs tag
= liftIO $
maybeWith withNamespace mbNs $ \nsPtr ->
withCString tag $ \cstr ->
do nodePtr <- xmlNewNode nsPtr cstr
mkFinalizedNode nodePtr
foreign import ccall unsafe xmlNewProp :: Ptr Node -> CString -> CString -> IO (Ptr Property)
newProperty :: MonadIO m => Node -> String -> String -> m ()
newProperty node name value
= liftIO $
withNode node $ \nodePtr ->
withCString name $ \namePtr ->
withCString value $ \valuePtr ->
do xmlNewProp nodePtr namePtr valuePtr
return ()
foreign import ccall unsafe xmlNewText :: CString -> IO (Ptr Node)
newText :: MonadIO m => String -> m Node
newText str
= liftIO $
do cstr <- newCString str
nodePtr <- xmlNewText cstr
mkFinalizedNode nodePtr
foreign import ccall unsafe xmlNewTextChild :: Ptr Node -> Ptr Namespace -> CString -> CString -> IO (Ptr Node)
newTextChild :: MonadIO m => Node -> Maybe Namespace -> String -> String -> m Node
newTextChild parent mbNs name content
= liftIO $
withNode parent $ \parentPtr ->
maybeWith withNamespace mbNs $ \nsPtr ->
withCString name $ \cname ->
withCString content $ \ccontent ->
mkFinalizedNode =<< xmlNewTextChild parentPtr nsPtr cname ccontent
foreign import ccall unsafe xmlNewDoc :: CString -> IO (Ptr Document)
newDocument :: MonadIO m => String
-> m Document
newDocument version
= liftIO $
withCString version $ \cstr ->
do docPtr <- xmlNewDoc cstr
mkFinalizedDocument docPtr
foreign import ccall unsafe xmlNewDocPI :: Ptr Document -> CString -> CString -> IO (Ptr Node)
newDocumentPI :: MonadIO m => Document -> String -> String -> m Node
newDocumentPI doc name content
= liftIO $
withDocument doc $ \docPtr ->
withCString name $ \namePtr ->
withCString content $ \contentPtr ->
do nodePtr <- xmlNewDocPI docPtr namePtr contentPtr
mkFinalizedNode nodePtr
foreign import ccall unsafe xmlDocDumpMemory :: Ptr Document -> Ptr CString -> Ptr CInt -> IO ()
documentDumpMemory :: MonadIO m => Document -> m ByteString
documentDumpMemory doc
= liftIO $
withDocument doc $ \docPtr ->
alloca $ \strPtr ->
alloca $ \lenPtr ->
do xmlDocDumpMemory docPtr strPtr lenPtr
cstr <- peek strPtr
len <- peek lenPtr
fp <- newForeignPtr finalizerFree (castPtr cstr)
return $! BS.PS fp 0 (fromIntegral len)
foreign import ccall unsafe xmlNewDocNode :: Ptr Document -> Ptr Namespace -> CString -> CString -> IO (Ptr Node)
newDocumentNode :: MonadIO m => Document -> Maybe Namespace -> String -> Maybe String -> m Node
newDocumentNode doc mbNs tag mbContents
= liftIO $
withDocument doc $ \docPtr ->
maybeWith withNamespace mbNs $ \nsPtr ->
withCString tag $ \ctag ->
maybeWith withCString mbContents $ \ccontents ->
do nodePtr <- xmlNewDocNode docPtr nsPtr ctag ccontents
mkFinalizedNode nodePtr
foreign import ccall unsafe xmlDocSetRootElement :: Ptr Document -> Ptr Node -> IO (Ptr Node)
setDocumentRootElement :: MonadIO m => Document -> Node -> m ()
setDocumentRootElement doc node
= liftIO $
withDocument doc $ \docPtr ->
withNode node $ \nodePtr ->
do xmlDocSetRootElement docPtr nodePtr
return ()
foreign import ccall unsafe xmlDocGetRootElement :: Ptr Document -> IO (Ptr Node)
getDocumentRootElement :: MonadIO m => Document -> m Node
getDocumentRootElement doc
= liftIO $
withDocument doc $ \docPtr ->
mkFinalizedNode =<< xmlDocGetRootElement docPtr