XSLT.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Network.HxWeb.XSLT
-- Copyright   :  (c) David Himmelstrup 2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Network.HxWeb.XSLT
    ( displayXml
    ) where

import qualified Text.XML.LibXML as XML
import qualified Text.XML.XSLT as XSLT
import Text.XML.XSLT (Stylesheet)
import Text.XML.LibXML (Node)

import qualified Data.ByteString.Lazy as Lazy
import Data.ByteString (ByteString)

import Data.Maybe

import Network.CGI

import Network.HxWeb.Monad

renderXML :: FilePath -> Node -> IO ByteString
renderXML path node
    = do doc <- XML.newDocument "1.0"
         piNode <- XML.newDocumentPI doc "xml-stylesheet" ("type=\"text/xsl\" href=\""++path++"\"")
         XML.setDocumentRootElement doc piNode
         XML.addSibling piNode node
         XML.documentDumpMemory doc

displayXml :: (FilePath -> WebPage st Stylesheet)
           -> Bool  -- ^ usexsl. False => transform xml on the server.
                    -- True => send xml + stylesheet to the client.
           -> (FilePath, Node) -> WebPage st CGIResult
displayXml fetchStylesheet usexsl (path, node)
    = do xml <- liftIO $ renderXML path node
         if usexsl
            then do setHeader "Content-type" "text/xml; charset=ISO-8859-1"
                    outputFPS (Lazy.LPS [xml])
            else do setHeader "Content-type" "text/html; charset=ISO-8859-1"
                    sheet <- fetchStylesheet path
                    doc <- liftIO $ XML.parseMemory xml
                    res <- liftIO $ XSLT.applyStylesheet sheet (Just doc) []
                    resBS <- liftIO $ XSLT.saveResultToString res sheet
                    outputFPS (Lazy.LPS [resBS])