{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} module Text.Templating.Heist.Splices.Markdown where ------------------------------------------------------------------------------ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Maybe import Control.Concurrent import Control.Exception (throwIO) import Control.Monad import Control.Monad.CatchIO import Control.Monad.Trans import Data.Typeable import Prelude hiding (catch) import System.Directory import System.Exit import System.IO import System.Process import Text.XML.Expat.Tree hiding (Node) ------------------------------------------------------------------------------ import Text.Templating.Heist.Constants import Text.Templating.Heist.Types data PandocMissingException = PandocMissingException deriving (Typeable) instance Show PandocMissingException where show PandocMissingException = "Cannot find the \"pandoc\" executable; is it on your $PATH?" instance Exception PandocMissingException data MarkdownException = MarkdownException ByteString deriving (Typeable) instance Show MarkdownException where show (MarkdownException e) = "Markdown error: pandoc replied:\n\n" ++ BC.unpack e instance Exception MarkdownException ------------------------------------------------------------------------------ -- | Default name for the markdown splice. markdownTag :: ByteString markdownTag = "markdown" ------------------------------------------------------------------------------ -- | Implementation of the markdown splice. markdownSplice :: MonadIO m => Splice m markdownSplice = do pdMD <- liftIO $ findExecutable "pandoc" when (isNothing pdMD) $ liftIO $ throwIO PandocMissingException tree <- getParamNode markup <- liftIO $ case getAttribute tree "file" of Just f -> pandoc (fromJust pdMD) $ BC.unpack f Nothing -> pandocBS (fromJust pdMD) $ textContent tree let ee = parse' heistExpatOptions markup case ee of (Left e) -> throw $ MarkdownException $ BC.pack ("Error parsing markdown output: " ++ show e) (Right n) -> return [n] pandoc :: FilePath -> FilePath -> IO ByteString pandoc pandocPath inputFile = do (ex, sout, serr) <- readProcessWithExitCode' pandocPath args "" when (isFail ex) $ throw $ MarkdownException serr return $ BC.concat [ "