xslt (empty) → 0.1

raw patch · 4 files changed

+161/−0 lines, 4 filesdep +basedep +libxmlbuild-type:Customsetup-changed

Dependencies added: base, libxml

Files

• LICENSE +35/−0
• Setup.lhs +5/−0
• src/Text/XML/XSLT.hs +104/−0
• xslt.cabal +17/−0

@@ -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.

@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,104 @@+module Text.XML.XSLT+    ( Stylesheet+    , parseFile+    , parseFile_+    , applyStylesheet+    , saveResultToString+    , saveResultToString_+    , cleanupGlobals+    , freeStylesheet+    ) where++import Foreign.C+import Foreign+import Control.Monad++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base as BS+import Data.ByteString (ByteString)++import qualified Text.XML.LibXML as XML+import qualified Text.XML.LibXML.Internals as XML+import Text.XML.LibXML (Document)++newtype Stylesheet = Stylesheet (ForeignPtr Stylesheet)++freeStylesheet :: Stylesheet -> IO ()+freeStylesheet (Stylesheet ptr) =+#if defined(__GLASGOW_HASKELL__)+  finalizeForeignPtr ptr+#else+  return ()+#endif+++-- xsltStylesheetPtr xsltParseStylesheetFile(const xmlChar * filename)+foreign import ccall unsafe xsltParseStylesheetFile :: CString -> IO (Ptr Stylesheet)++parseFile :: FilePath -> IO Stylesheet+parseFile path+    = do mbSheet <- parseFile_ path+         case mbSheet of+           Nothing -> error $ "Text.XML.XSLT.parseFile: failed to parse input from: " ++ path+           Just sheet -> return sheet++parseFile_ :: FilePath -> IO (Maybe Stylesheet)+parseFile_ path+    = do ptr <- xsltParseStylesheetFile =<< newCString path+         if ptr == nullPtr+            then return Nothing+            else liftM Just $ mkFinalizedStylesheet ptr++-- xmlDocPtr xsltApplyStylesheet(xsltStylesheetPtr style, xmlDocPtr doc, const char ** params)+foreign import ccall unsafe xsltApplyStylesheet :: Ptr Stylesheet -> Ptr Document -> Ptr CString -> IO (Ptr Document)++-- FIXME: don't ignore the params+applyStylesheet :: Stylesheet -> Maybe Document -> [(ByteString,ByteString)] -> IO Document+applyStylesheet (Stylesheet stylesheet) mbDocument _params+    = withForeignPtr stylesheet $ \sheetptr ->+      withMbDoc mbDocument $ \docPtr ->+      do ptr <- xsltApplyStylesheet sheetptr docPtr nullPtr+         XML.mkFinalizedDocument ptr+    where withMbDoc Nothing x = x nullPtr+          withMbDoc (Just doc) x = XML.withDocument doc x++--int xsltSaveResultToString(xmlChar ** doc_txt_ptr, +--                           int * doc_txt_len, +--                            xmlDocPtr result, +--                                       xsltStylesheetPtr style)+foreign import ccall unsafe xsltSaveResultToString+    :: Ptr CString -> Ptr CInt -> Ptr Document -> Ptr Stylesheet -> IO CInt++saveResultToString :: Document -> Stylesheet -> IO ByteString+saveResultToString doc stylesheet+    = do mbStr <- saveResultToString_ doc stylesheet+         case mbStr of+           Nothing -> error "Text.XML.XSLT.saveResultToString: failed to save result"+           Just str -> return str++saveResultToString_ :: Document -> Stylesheet -> IO (Maybe ByteString)+saveResultToString_ doc (Stylesheet sheet)+    = withForeignPtr sheet $ \sheetPtr ->+      XML.withDocument doc $ \docPtr ->+      alloca $ \strPtr ->+      alloca $ \lenPtr ->+      do ret <- xsltSaveResultToString strPtr lenPtr docPtr sheetPtr+         case ret of+           (-1) -> return Nothing+           _    -> do cstr <- peek strPtr+                      len  <- peek lenPtr+                      fp <- newForeignPtr finalizerFree (castPtr cstr)+                      return $! Just $! BS.PS fp 0 (fromIntegral len)++foreign import ccall unsafe "xsltCleanupGlobals" cleanupGlobals :: IO ()++foreign import ccall unsafe "&xsltFreeStylesheet" xsltFreeStylesheet :: FunPtr (Ptr Stylesheet -> IO ())++mkFinalizedStylesheet :: Ptr Stylesheet -> IO Stylesheet+mkFinalizedStylesheet = liftM Stylesheet . newForeignPtr xsltFreeStylesheet++++++

@@ -0,0 +1,17 @@+Name: xslt+Version: 0.1+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2006, Lemmih+License-File: LICENSE+License: BSD3+Build-Depends: base, libxml+Category: Foreign binding+Synopsis: Binding to libxslt+Extensions: CPP, ForeignFunctionInterface+Hs-Source-Dirs: src+Exposed-Modules:+  Text.XML.XSLT+Includes: libxslt/xslt.h libxslt/xsltInternals.h libxslt/transform.h libxslt/xsltutils.h+Extra-Libraries: xslt+GHC-Options: -fglasgow-exts -Wall -Werror -O2