{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Templates Copyright : Copyright (C) 2009-2020 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Utility functions for working with pandoc templates. -} module Text.Pandoc.Templates ( Template , WithDefaultPartials(..) , WithPartials(..) , compileTemplate , renderTemplate , getTemplate , getDefaultTemplate , compileDefaultTemplate ) where import Prelude import System.FilePath ((<.>), (), takeFileName) import Text.DocTemplates (Template, TemplateMonad(..), compileTemplate, renderTemplate) import Text.Pandoc.Class (PandocMonad, readDataFile, fetchItem, CommonState(..), getCommonState, modifyCommonState) import qualified Text.Pandoc.UTF8 as UTF8 import Control.Monad.Except (catchError, throwError) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Error -- | Wrap a Monad in this if you want partials to -- be taken only from the default data files. newtype WithDefaultPartials m a = WithDefaultPartials { runWithDefaultPartials :: m a } deriving (Functor, Applicative, Monad) -- | Wrap a Monad in this if you want partials to -- be looked for locally (or, when the main template -- is at a URL, via HTTP), falling back to default data files. newtype WithPartials m a = WithPartials { runWithPartials :: m a } deriving (Functor, Applicative, Monad) instance PandocMonad m => TemplateMonad (WithDefaultPartials m) where getPartial fp = WithDefaultPartials $ UTF8.toText <$> readDataFile ("templates" takeFileName fp) instance PandocMonad m => TemplateMonad (WithPartials m) where getPartial fp = WithPartials $ getTemplate fp -- | Retrieve text for a template. getTemplate :: PandocMonad m => FilePath -> m Text getTemplate tp = UTF8.toText <$> ((do surl <- stSourceURL <$> getCommonState -- we don't want to look for templates remotely -- unless the full URL is specified: modifyCommonState $ \st -> st{ stSourceURL = Nothing } (bs, _) <- fetchItem $ T.pack tp modifyCommonState $ \st -> st{ stSourceURL = surl } return bs) `catchError` (\e -> case e of PandocResourceNotFound _ -> -- see #5987 on reason for takeFileName readDataFile ("templates" takeFileName tp) _ -> throwError e)) -- | Get default template for the specified writer. getDefaultTemplate :: PandocMonad m => Text -- ^ Name of writer -> m Text getDefaultTemplate writer = do let format = T.takeWhile (`notElem` ("+-" :: String)) writer -- strip off extensions case format of "native" -> return "" "json" -> return "" "docx" -> return "" "fb2" -> return "" "pptx" -> return "" "ipynb" -> return "" "odt" -> getDefaultTemplate "opendocument" "html" -> getDefaultTemplate "html5" "docbook" -> getDefaultTemplate "docbook5" "epub" -> getDefaultTemplate "epub3" "beamer" -> getDefaultTemplate "latex" "jats" -> getDefaultTemplate "jats_archiving" "markdown_strict" -> getDefaultTemplate "markdown" "multimarkdown" -> getDefaultTemplate "markdown" "markdown_github" -> getDefaultTemplate "markdown" "markdown_mmd" -> getDefaultTemplate "markdown" "markdown_phpextra" -> getDefaultTemplate "markdown" "gfm" -> getDefaultTemplate "commonmark" _ -> do let fname = "templates" "default" <.> T.unpack format UTF8.toText <$> readDataFile fname -- | Get and compile default template for the specified writer. -- Raise an error on compilation failure. compileDefaultTemplate :: PandocMonad m => Text -> m (Template Text) compileDefaultTemplate writer = do res <- getDefaultTemplate writer >>= runWithDefaultPartials . compileTemplate ("templates/default." <> T.unpack writer) case res of Left e -> throwError $ PandocTemplateError (T.pack e) Right t -> return t