{-# LINE 1 "src/Text/XML/C14N/LibXML.hsc" #-}
--------------------------------------------------------------------------------
-- Haskell bindings for c14n implementation in libxml                         --
--------------------------------------------------------------------------------
-- This source code is licensed under the MIT license found in the LICENSE    --
-- file in the root directory of this source tree.                            --
--------------------------------------------------------------------------------

-- | Bindings to libxml types and functions required for the c14n 
-- implementation. See http://xmlsoft.org/html/libxml-c14n.html
module Text.XML.C14N.LibXML (
    -- * libxml2 types
    LibXMLDoc,
    LibXMLNodeSet,
    LibXMLChar,
    LibXMLXPathCtx,
    LibXMLXPathObj,

    -- * Memory-related functions
    freeXml,

    -- * Parsing
    -- See http://xmlsoft.org/html/libxml-parser.html
    xml_opt_recover, 
    xml_opt_noent,
    xml_opt_dtdload,
    xml_opt_dtdattr,
    xml_opt_dtdvalid,
    xml_opt_noerror,
    xml_opt_nowarning,
    xml_opt_pedantic,
    xml_opt_noblanks,
    xml_opt_sax1,
    xml_opt_xinclude,
    xml_opt_nonet,
    xml_opt_nodict,
    xml_opt_nsclean,
    xml_opt_nocdata,
    xml_opt_noxincnode,
    xml_opt_compact,
    xml_opt_old10,
    xml_opt_nobasefix,
    xml_opt_huge,
    xml_opt_oldsax,
    xml_opt_ignore_env,
    xml_opt_big_lines,
    xmlReadMemory,
    xmlFreeDoc,

    -- * XML canonicalisation
    -- See http://xmlsoft.org/html/libxml-c14n.html
    c14n_1_0,
    c14n_exclusive_1_0,
    c14n_1_1,
    xmlC14NDocDumpMemory,

    -- * XPath
    -- See http://xmlsoft.org/html/libxml-xpath.html
    xmlXPathNewContext,
    xmlXPathFreeContext,
    xmlXPathEval,
    xmlXPathFreeObject
) where 

--------------------------------------------------------------------------------




import Data.Word

import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types

--------------------------------------------------------------------------------

-- | Original C14N 1.0 specification.
c14n_1_0 :: CInt 
c14n_1_0 :: CInt
c14n_1_0 = CInt
0
{-# LINE 80 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Exclusive C14N 1.0 specification.
c14n_exclusive_1_0 :: CInt 
c14n_exclusive_1_0 :: CInt
c14n_exclusive_1_0 = CInt
1
{-# LINE 84 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | C14N 1.1 specification.
c14n_1_1 :: CInt 
c14n_1_1 :: CInt
c14n_1_1 = CInt
2
{-# LINE 88 "src/Text/XML/C14N/LibXML.hsc" #-}

--------------------------------------------------------------------------------

-- | Recover on errors.
xml_opt_recover :: CInt 
xml_opt_recover :: CInt
xml_opt_recover = CInt
1
{-# LINE 94 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Substitute entities.
xml_opt_noent :: CInt
xml_opt_noent :: CInt
xml_opt_noent = CInt
2
{-# LINE 98 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Load the external subset.
xml_opt_dtdload :: CInt 
xml_opt_dtdload :: CInt
xml_opt_dtdload = CInt
4
{-# LINE 102 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Default DTD attributes.
xml_opt_dtdattr :: CInt 
xml_opt_dtdattr :: CInt
xml_opt_dtdattr = CInt
8
{-# LINE 106 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Validate with the DTD.
xml_opt_dtdvalid :: CInt 
xml_opt_dtdvalid :: CInt
xml_opt_dtdvalid = CInt
16
{-# LINE 110 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Suppress error reports.
xml_opt_noerror :: CInt 
xml_opt_noerror :: CInt
xml_opt_noerror = CInt
32
{-# LINE 114 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Suppress warning reports.
xml_opt_nowarning :: CInt 
xml_opt_nowarning :: CInt
xml_opt_nowarning = CInt
64
{-# LINE 118 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Pedantic error reporting.
xml_opt_pedantic :: CInt 
xml_opt_pedantic :: CInt
xml_opt_pedantic = CInt
128
{-# LINE 122 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Remove blank nodes.
xml_opt_noblanks :: CInt 
xml_opt_noblanks :: CInt
xml_opt_noblanks = CInt
256
{-# LINE 126 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Use the SAX1 interface internally.
xml_opt_sax1 :: CInt 
xml_opt_sax1 :: CInt
xml_opt_sax1 = CInt
512
{-# LINE 130 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Implement XInclude substitution.
xml_opt_xinclude :: CInt 
xml_opt_xinclude :: CInt
xml_opt_xinclude = CInt
1024
{-# LINE 134 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Forbid network access.
xml_opt_nonet :: CInt
xml_opt_nonet :: CInt
xml_opt_nonet = CInt
2048
{-# LINE 138 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Do not reuse the context dictionary.
xml_opt_nodict :: CInt
xml_opt_nodict :: CInt
xml_opt_nodict = CInt
4096
{-# LINE 142 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Remove redundant namespaces declarations.
xml_opt_nsclean :: CInt
xml_opt_nsclean :: CInt
xml_opt_nsclean = CInt
8192
{-# LINE 146 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Merge CDATA as text nodes.
xml_opt_nocdata :: CInt
xml_opt_nocdata :: CInt
xml_opt_nocdata = CInt
16384
{-# LINE 150 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Do not generate XINCLUDE START/END nodes.
xml_opt_noxincnode :: CInt
xml_opt_noxincnode :: CInt
xml_opt_noxincnode = CInt
32768
{-# LINE 154 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Compact small text nodes; no modification of the tree allowed afterwards
-- (will probably crash if you try to modify the tree)
xml_opt_compact :: CInt
xml_opt_compact :: CInt
xml_opt_compact = CInt
65536
{-# LINE 159 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Parse using XML-1.0 before update 5.
xml_opt_old10 :: CInt
xml_opt_old10 :: CInt
xml_opt_old10 = CInt
131072
{-# LINE 163 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Do not fixup XINCLUDE xml:base uris.
xml_opt_nobasefix :: CInt
xml_opt_nobasefix :: CInt
xml_opt_nobasefix = CInt
262144
{-# LINE 167 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Relax any hardcoded limit from the parser.
xml_opt_huge :: CInt
xml_opt_huge :: CInt
xml_opt_huge = CInt
524288
{-# LINE 171 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Parse using SAX2 interface before 2.7.0.
xml_opt_oldsax :: CInt
xml_opt_oldsax :: CInt
xml_opt_oldsax = CInt
1048576
{-# LINE 175 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Ignore internal document encoding hint.
xml_opt_ignore_env :: CInt
xml_opt_ignore_env :: CInt
xml_opt_ignore_env = CInt
2097152
{-# LINE 179 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | Store big lines numbers in text PSVI field.
xml_opt_big_lines :: CInt
xml_opt_big_lines :: CInt
xml_opt_big_lines = CInt
4194304
{-# LINE 183 "src/Text/XML/C14N/LibXML.hsc" #-}

--------------------------------------------------------------------------------

-- | XML documents
data LibXMLDoc 

-- | XML node sets
data LibXMLNodeSet

-- | XML strings
type LibXMLChar = Word8
{-# LINE 194 "src/Text/XML/C14N/LibXML.hsc" #-}

-- | XML XPath contexts
data LibXMLXPathCtx

-- | XML XPath objects
data LibXMLXPathObj

-- | Free an XML object.
foreign import ccall unsafe "freeXml"
    freeXml :: Ptr a -> IO ()

-- | Free an XML document.
foreign import ccall unsafe "libxml/tree.h &xmlFreeDoc"
    xmlFreeDoc :: FunPtr ((Ptr LibXMLDoc) -> IO ())

-- | Parses an XML document from a textual representation held in memory.
foreign import ccall unsafe "libxml/parser.h xmlReadMemory"
    xmlReadMemory :: CString 
                  -> CInt 
                  -> CString 
                  -> CString 
                  -> CInt 
                  -> IO (Ptr LibXMLDoc)

-- | Writes the canonicalised representation of an XML document to memory.
foreign import ccall unsafe "libxml/c14n.h xmlC14NDocDumpMemory"
  xmlC14NDocDumpMemory :: Ptr LibXMLDoc -- ^ The XML document to canonicalise.
                       -> Ptr LibXMLNodeSet -- ^ The nodes set to be included
                                            -- in the canonicalised output.
                       -> CInt -- ^ The canonicalisation mode.
                       -> Ptr (Ptr LibXMLChar) -- ^ A list of inclusive 
                                               -- namespace prefixes
                       -> CInt -- ^ A boolean value indicating whether comments
                               -- should be included in the result or not.
                       -> Ptr (Ptr LibXMLChar) -- ^ A memory address to which
                                               -- the output should be written.
                       -> IO CInt

-- | Creates a new XPath context for the given document.
foreign import ccall unsafe "libxml/xpath.h xmlXPathNewContext"
    xmlXPathNewContext :: Ptr LibXMLDoc -> IO (Ptr LibXMLXPathCtx)

-- | Frees up an 'LibXMLXPathCtx' context.
foreign import ccall unsafe "libxml/xpath.h xmlXPathFreeContext"
    xmlXPathFreeContext :: Ptr LibXMLXPathCtx -> IO ()

-- | 'xmlXPathEval' @pathPtr ctxPtr@ evaluates the XPath location path
-- pointed at by @pathPtr@ in the XPath context pointed at by @ctxPtr@. 
foreign import ccall unsafe "libxml/xpath.h xmlXPathEval"
    xmlXPathEval :: Ptr LibXMLChar 
                 -> Ptr LibXMLXPathCtx 
                 -> IO (Ptr LibXMLXPathObj)

-- | Free up an 'LibXMLXPathObj' object.
foreign import ccall unsafe "libxml/xpath.h xmlXPathFreeObject"
    xmlXPathFreeObject :: Ptr LibXMLXPathObj -> IO ()

--------------------------------------------------------------------------------