{-# LANGUAGE 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.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T 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.FilePath.Posix import System.IO import System.Process import Text.XmlHtml ------------------------------------------------------------------------------ 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 :: Text markdownTag = "markdown" ------------------------------------------------------------------------------ -- | Implementation of the markdown splice. markdownSplice :: MonadIO m => FilePath -> Splice m markdownSplice templatePath = do pdMD <- liftIO $ findExecutable "pandoc" when (isNothing pdMD) $ liftIO $ throwIO PandocMissingException tree <- getParamNode (source,markup) <- liftIO $ case getAttribute "file" tree of Just f -> do m <- pandoc (fromJust pdMD) templatePath $ T.unpack f return (T.unpack f,m) Nothing -> do m <- pandocBS (fromJust pdMD) $ T.encodeUtf8 $ nodeText tree return ("inline_splice",m) let ee = parseHTML source markup case ee of Left e -> throw $ MarkdownException $ BC.pack ("Error parsing markdown output: " ++ e) Right d -> return (docContent d) pandoc :: FilePath -> FilePath -> FilePath -> IO ByteString pandoc pandocPath templatePath inputFile = do (ex, sout, serr) <- readProcessWithExitCode' pandocPath args "" when (isFail ex) $ throw $ MarkdownException serr return $ BC.concat [ "