packages feed

libxml (empty) → 0.1

raw patch · 8 files changed

+363/−0 lines, 8 filesdep +basedep +mtlbuild-type:Customsetup-changed

Dependencies added: base, mtl

Files

+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2006, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++    * Redistributions of source code must retain+      the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce+      the above copyright notice, this list of+      conditions and the following disclaimer in the+      documentation and/or other materials provided+      with the distribution.+    * Neither the name of David Himmelstrup nor the+      names of other contributors may be used to+      endorse or promote products derived from this+      software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks defaultUserHooks
+ libxml.cabal view
@@ -0,0 +1,23 @@+Name: libxml+Version: 0.1+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2006, Lemmih+License-File: LICENSE+License: BSD3+Build-Depends: base, mtl+Category: Foreign binding+Synopsis: Binding to libxml2+Description:+  Minimal binding to libxml2. Additional functions will be added when needed.+Extensions: CPP, ForeignFunctionInterface+Hs-Source-Dirs: src+Exposed-Modules:+  Text.XML.LibXML+  Text.XML.LibXML.Types+  Text.XML.LibXML.Internals+  Text.XML.LibXML.Tree+  Text.XML.LibXML.Parser+Includes: libxml/xmlIO.h libxml/xmlmemory.h+Extra-Libraries: xml2+GHC-Options: -fglasgow-exts -Wall -Werror -O2
+ src/Text/XML/LibXML.hs view
@@ -0,0 +1,11 @@+module Text.XML.LibXML+    ( module Text.XML.LibXML.Types+    , module Text.XML.LibXML.Parser+    , module Text.XML.LibXML.Tree+    ) where++import Text.XML.LibXML.Types+import Text.XML.LibXML.Tree+import Text.XML.LibXML.Parser++
+ src/Text/XML/LibXML/Internals.hs view
@@ -0,0 +1,28 @@+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_++
+ src/Text/XML/LibXML/Parser.hs view
@@ -0,0 +1,72 @@+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.Base 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 pat+    = 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 ()+
+ src/Text/XML/LibXML/Tree.hs view
@@ -0,0 +1,169 @@+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
+ src/Text/XML/LibXML/Types.hs view
@@ -0,0 +1,20 @@+module Text.XML.LibXML.Types where++import Foreign++newtype Document = Document (ForeignPtr Document)+newtype Node = Node (ForeignPtr Node)+newtype Property = Property (ForeignPtr Property)+newtype Namespace = Namespace (ForeignPtr Namespace)++withDocument :: Document -> (Ptr Document -> IO a) -> IO a+withDocument (Document ptr) = withForeignPtr ptr++withNode :: Node -> (Ptr Node -> IO a) -> IO a+withNode (Node ptr) = withForeignPtr ptr++withProperty :: Property -> (Ptr Property -> IO a) -> IO a+withProperty (Property ptr) = withForeignPtr ptr++withNamespace :: Namespace -> (Ptr Namespace -> IO a) -> IO a+withNamespace (Namespace ptr) = withForeignPtr ptr