aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/App/OutputSettings.hs36
-rw-r--r--src/Text/Pandoc/Class.hs11
-rw-r--r--src/Text/Pandoc/Templates.hs61
3 files changed, 65 insertions, 43 deletions
diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
index 944f1b63b..9a8e9969f 100644
--- a/src/Text/Pandoc/App/OutputSettings.hs
+++ b/src/Text/Pandoc/App/OutputSettings.hs
@@ -25,7 +25,7 @@ import qualified Data.Text as T
import Text.DocTemplates (toVal, Context(..), Val(..))
import qualified Control.Exception as E
import Control.Monad
-import Control.Monad.Except (catchError, throwError)
+import Control.Monad.Except (throwError)
import Control.Monad.Trans
import Data.Char (toLower)
import Data.List (find, isPrefixOf)
@@ -171,40 +171,18 @@ optToOutputSettings opts = do
setVariableM "dzslides-core" dzcore vars
else return vars)
- templStr <- case optTemplate opts of
+ templ <- case optTemplate opts of
_ | not standalone -> return Nothing
- Nothing -> Just <$> getDefaultTemplate format
+ Nothing -> Just <$> compileDefaultTemplate format
Just tp -> do
-- strip off extensions
let tp' = case takeExtension tp of
"" -> tp <.> T.unpack format
_ -> tp
- Just . 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 _ ->
- readDataFile ("templates" </> tp')
- _ -> throwError e))
-
- let templatePath = fromMaybe "" $ optTemplate opts
-
- templ <- case templStr of
- Nothing -> return Nothing
- Just ts -> do
- res <- compileTemplate templatePath ts
- case res of
- Left e -> throwError $ PandocTemplateError $ T.pack e
- Right t -> return $ Just t
+ res <- getTemplate tp' >>= runWithPartials . compileTemplate tp'
+ case res of
+ Left e -> throwError $ PandocTemplateError $ T.pack e
+ Right t -> return $ Just t
let writerOpts = def {
writerTemplate = templ
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index 8449e4a0e..098d95a09 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -91,7 +91,6 @@ import Text.Parsec (ParsecT, getPosition, sourceLine, sourceName)
import qualified Data.Time as IO (getCurrentTime)
import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
import Text.Pandoc.Definition
-import Text.DocTemplates (TemplateMonad(..))
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Maybe (fromMaybe)
import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
@@ -315,16 +314,6 @@ readFileFromDirs (d:ds) f = catchError
((Just . T.pack . UTF8.toStringLazy) <$> readFileLazy (d </> f))
(\_ -> readFileFromDirs ds f)
-instance TemplateMonad PandocIO where
- getPartial fp = UTF8.toText <$> catchError
- (readFileStrict fp)
- (\_ -> readDataFile ("templates" </> fp))
-
-instance TemplateMonad PandocPure where
- getPartial fp = UTF8.toText <$> catchError
- (readFileStrict fp)
- (\_ -> readDataFile ("templates" </> fp))
-
-- | 'CommonState' represents state that is used by all
-- instances of 'PandocMonad'. Normally users should not
-- need to interact with it directly; instead, auxiliary
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 8d92e306b..daf9c02fb 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -14,18 +15,61 @@ 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 ((<.>), (</>))
-import Text.DocTemplates (Template, compileTemplate, renderTemplate)
-import Text.Pandoc.Class (PandocMonad, readDataFile)
+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 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 _ ->
+ readDataFile ("templates" </> tp)
+ _ -> throwError e))
-- | Get default template for the specified writer.
getDefaultTemplate :: PandocMonad m
@@ -55,4 +99,15 @@ getDefaultTemplate writer = 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-02 15:54:58 +0000