libxml-0.1: src/Text/XML/LibXML/Tree.hs

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.Base as BS
import Data.ByteString (ByteString)

import Text.XML.LibXML.Types
import Text.XML.LibXML.Internals

-- xmlNodePtr xmlAddChild (xmlNodePtr parent, xmlNodePtr cur)
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 ()

--xmlNodePtr xmlNewChild(xmlNodePtr parent, xmlNsPtr ns, const xmlChar * name, const xmlChar * content)
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

-- xmlNodePtr xmlAddNextSibling (xmlNodePtr parent, xmlNodePtr cur)
-- xmlNodePtr xmlAddPrevSibling (xmlNodePtr parent, xmlNodePtr cur)
-- xmlNodePtr xmlAddSibling (xmlNodePtr parent, xmlNodePtr cur)
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 ()

-- xmlNodePtr xmlNewNode (xmlNsPtr ns, const xmlChar * name)
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

-- xmlNodePtr xmlNewNodeEatName (xmlNsPtr ns, const xmlChar * name)

-- xmlAttrPtr xmlNewProp (xmlNodePtr node, const xmlChar * name, const xmlChar * value)
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 ()

-- xmlNodePtr xmlNewText (const xmlChar * content)
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

-- xmlNodePtr xmlNewTextChild(xmlNodePtr parent, xmlNsPtr ns, const xmlChar * name, const xmlChar * content)
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

--xmlDocPtr xmlNewDoc(const xmlChar * version)
foreign import ccall unsafe xmlNewDoc :: CString -> IO (Ptr Document)
newDocument :: MonadIO m => String -- ^ Version
            -> m Document
newDocument version
    = liftIO $
      withCString version $ \cstr ->
      do docPtr <- xmlNewDoc cstr
         mkFinalizedDocument docPtr

-- xmlNodePtr xmlNewDocPI(xmlDocPtr doc, const xmlChar * name, const xmlChar * content)
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

--void xmlDocDumpMemory(xmlDocPtr cur, xmlChar ** mem, int * size)
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)

-- xmlNodePtr xmlNewDocNode(xmlDocPtr doc, xmlNsPtr ns, const xmlChar * name, const xmlChar * content)
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

-- xmlNodePtr xmlDocSetRootElement(xmlDocPtr doc, xmlNodePtr root)
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 ()

--xmlNodePtr xmlDocGetRootElement(xmlDocPtr doc)
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