module Text.XML.LibXML.Internals where

import Foreign
import Control.Monad

import Text.XML.LibXML.Types

-- void xmlFreeDoc(xmlDocPtr cur)
-- | Force the finalization of a document. This function is a no-op on non-ghc systems.
freeDocument :: Document -> IO ()
freeDocument (Document ptr) =
#if defined(__GLASGOW_HASKELL__)
  finalizeForeignPtr ptr
#else
  return ()
#endif

foreign import ccall unsafe "&xmlFreeNode" xmlFreeNode :: FunPtr (Ptr Node -> IO ())
foreign import ccall unsafe "&xmlFreeDoc" xmlFreeDoc :: FunPtr (Ptr Document -> IO ())

mkFinalizedDocument :: Ptr Document -> IO Document
mkFinalizedDocument = liftM Document . newForeignPtr xmlFreeDoc

-- Don't free nodes.
mkFinalizedNode :: Ptr Node -> IO Node
mkFinalizedNode = liftM Node . newForeignPtr_