Parser.hs

module Text.XML.LibXML.Parser
    ( parseFile
    , parseFile_
    , parseMemory
    , parseMemory_
    , cleanupParser
    , substituteEntitiesDefault
    ) where

import Foreign.C
import Foreign
import Control.Monad
import Control.Monad.Trans

import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Data.ByteString (ByteString)

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

-- xmlDocPtr xmlParseFile(const char * filename)
foreign import ccall unsafe xmlParseFile :: CString -> IO (Ptr Document)

-- | Parse XML document from a file. Throws an exception on error.
parseFile :: MonadIO m => FilePath -> m Document
parseFile path
    = do mbDoc <- parseFile_ path
         case mbDoc of
           Nothing -> error $ "Text.XML.LibXml.parseFile: failed to parse input from: " ++ path
           Just doc -> return doc

parseFile_ :: MonadIO m => FilePath -> m (Maybe Document)
parseFile_ path
    = liftIO $
      do ptr <- xmlParseFile =<< newCString path
         if ptr == nullPtr
            then return Nothing
            else liftM Just $ mkFinalizedDocument ptr

-- xmlDocPtr xmlParseMemory(const char * buffer, int size)
foreign import ccall unsafe xmlParseMemory :: CString -> CInt -> IO (Ptr Document)

parseMemory :: MonadIO m => ByteString -> m Document
parseMemory bs
    = do mbDoc <- parseMemory_ bs
         case mbDoc of
           Nothing -> error "Text.XML.LibXml.parseMemory: failed to parse input"
           Just doc -> return doc

parseMemory_ :: MonadIO m => ByteString -> m (Maybe Document)
parseMemory_ bs
    = liftIO $
      BS.unsafeUseAsCStringLen bs $ \(cstr, len) ->
      do ptr <- xmlParseMemory cstr (fromIntegral len)
         if ptr == nullPtr
            then return Nothing
            else liftM Just $ mkFinalizedDocument ptr

-- int xmlSubstituteEntitiesDefault(int val)
foreign import ccall unsafe xmlSubstituteEntitiesDefault :: CInt -> IO CInt

-- | Set and return the previous value for default entity support.
substituteEntitiesDefault :: MonadIO m => Bool -> m Bool
substituteEntitiesDefault val
    = liftIO $
      do ret <- xmlSubstituteEntitiesDefault (fromBool val)
         return (toBool ret)

-- void xmlCleanupParser(void)
foreign import ccall unsafe "xmlCleanupParser" cleanupParser :: IO ()