XSLT.hs

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 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
                      str <- BS.packCString cstr
                      return $! Just $! str

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