{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Templates
   Copyright   : Copyright (C) 2009-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Utility functions for working with pandoc templates.

'WithDefaultPartials' and 'WithPartials' are Monad wrappers. Wrapping
these around an instance of 'PandocMonad' gives different instances of
'TemplateMonad', with different search behaviors when retrieving
partials.

To compile a template and limit partial search to pandoc’s data files,
use @runWithDefaultPartials (compileTemplate ...)@.

To compile a template and allow partials to be found locally (either on
the file system or via HTTP, in the event that the main template has an
absolute URL), ue @runWithPartials (compileTemplate ...)@.

'getTemplate' seeks a template locally, or via HTTP if the template has
an absolute URL, falling back to the data files if not found.

-}

module Text.Pandoc.Templates ( Template
                             , WithDefaultPartials(..)
                             , WithPartials(..)
                             , compileTemplate
                             , renderTemplate
                             , getTemplate
                             , getDefaultTemplate
                             , compileDefaultTemplate
                             ) where

import System.FilePath ((<.>), (</>), takeFileName)
import Text.DocTemplates (Template, TemplateMonad(..), compileTemplate, renderTemplate)
import Text.Pandoc.Class.CommonState (CommonState(..))
import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem,
                                      getCommonState, modifyCommonState,
                                      toTextM)
import Text.Pandoc.Data (readDataFile)
import Control.Monad.Except (catchError, throwError)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Error
import System.IO.Error (isDoesNotExistError)

-- | Wrap a Monad in this if you want partials to
-- be taken only from the default data files.
newtype WithDefaultPartials m a = WithDefaultPartials { forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials :: m a }
 deriving (forall a b. a -> WithDefaultPartials m b -> WithDefaultPartials m a
forall a b.
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithDefaultPartials m b -> WithDefaultPartials m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WithDefaultPartials m b -> WithDefaultPartials m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithDefaultPartials m b -> WithDefaultPartials m a
fmap :: forall a b.
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
Functor, forall a. a -> WithDefaultPartials m a
forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a
forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
forall a b.
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
forall a b c.
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}.
Applicative m =>
Functor (WithDefaultPartials m)
forall (m :: * -> *) a.
Applicative m =>
a -> WithDefaultPartials m a
forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a
forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
<* :: forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a
*> :: forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
<*> :: forall a b.
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
pure :: forall a. a -> WithDefaultPartials m a
$cpure :: forall (m :: * -> *) a.
Applicative m =>
a -> WithDefaultPartials m a
Applicative, forall a. a -> WithDefaultPartials m a
forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
forall a b.
WithDefaultPartials m a
-> (a -> WithDefaultPartials m b) -> WithDefaultPartials m b
forall {m :: * -> *}.
Monad m =>
Applicative (WithDefaultPartials m)
forall (m :: * -> *) a. Monad m => a -> WithDefaultPartials m a
forall (m :: * -> *) a b.
Monad m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
forall (m :: * -> *) a b.
Monad m =>
WithDefaultPartials m a
-> (a -> WithDefaultPartials m b) -> WithDefaultPartials m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WithDefaultPartials m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithDefaultPartials m a
>> :: forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
>>= :: forall a b.
WithDefaultPartials m a
-> (a -> WithDefaultPartials m b) -> WithDefaultPartials m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithDefaultPartials m a
-> (a -> WithDefaultPartials m b) -> WithDefaultPartials m b
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 { forall (m :: * -> *) a. WithPartials m a -> m a
runWithPartials :: m a }
 deriving (forall a b. a -> WithPartials m b -> WithPartials m a
forall a b. (a -> b) -> WithPartials m a -> WithPartials m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithPartials m b -> WithPartials m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithPartials m a -> WithPartials m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WithPartials m b -> WithPartials m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithPartials m b -> WithPartials m a
fmap :: forall a b. (a -> b) -> WithPartials m a -> WithPartials m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithPartials m a -> WithPartials m b
Functor, forall a. a -> WithPartials m a
forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m a
forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b
forall a b.
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
forall a b c.
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (WithPartials m)
forall (m :: * -> *) a. Applicative m => a -> WithPartials m a
forall (m :: * -> *) a b.
Applicative m =>
WithPartials m a -> WithPartials m b -> WithPartials m a
forall (m :: * -> *) a b.
Applicative m =>
WithPartials m a -> WithPartials m b -> WithPartials m b
forall (m :: * -> *) a b.
Applicative m =>
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
<* :: forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WithPartials m a -> WithPartials m b -> WithPartials m a
*> :: forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithPartials m a -> WithPartials m b -> WithPartials m b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
<*> :: forall a b.
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
pure :: forall a. a -> WithPartials m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> WithPartials m a
Applicative, forall a. a -> WithPartials m a
forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b
forall a b.
WithPartials m a -> (a -> WithPartials m b) -> WithPartials m b
forall {m :: * -> *}. Monad m => Applicative (WithPartials m)
forall (m :: * -> *) a. Monad m => a -> WithPartials m a
forall (m :: * -> *) a b.
Monad m =>
WithPartials m a -> WithPartials m b -> WithPartials m b
forall (m :: * -> *) a b.
Monad m =>
WithPartials m a -> (a -> WithPartials m b) -> WithPartials m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WithPartials m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithPartials m a
>> :: forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithPartials m a -> WithPartials m b -> WithPartials m b
>>= :: forall a b.
WithPartials m a -> (a -> WithPartials m b) -> WithPartials m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithPartials m a -> (a -> WithPartials m b) -> WithPartials m b
Monad)

instance PandocMonad m => TemplateMonad (WithDefaultPartials m) where
  getPartial :: FilePath -> WithDefaultPartials m Text
getPartial FilePath
fp = forall (m :: * -> *) a. m a -> WithDefaultPartials m a
WithDefaultPartials forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
fp) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fp

instance PandocMonad m => TemplateMonad (WithPartials m) where
  getPartial :: FilePath -> WithPartials m Text
getPartial FilePath
fp = forall (m :: * -> *) a. m a -> WithPartials m a
WithPartials forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => FilePath -> m Text
getTemplate FilePath
fp

-- | Retrieve text for a template.
getTemplate :: PandocMonad m => FilePath -> m Text
getTemplate :: forall (m :: * -> *). PandocMonad m => FilePath -> m Text
getTemplate FilePath
tp =
  ((do Maybe Text
surl <- CommonState -> Maybe Text
stSourceURL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
       -- we don't want to look for templates remotely
       -- unless the full URL is specified:
       forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{
         stSourceURL :: Maybe Text
stSourceURL = forall a. Maybe a
Nothing }
       (ByteString
bs, Maybe Text
_) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
tp
       forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{
         stSourceURL :: Maybe Text
stSourceURL = Maybe Text
surl }
       forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs)
   forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError`
   (\PandocError
e -> case PandocError
e of
             PandocResourceNotFound Text
_ ->
                -- see #5987 on reason for takeFileName
                forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
tp)
             PandocIOError Text
_ IOError
ioe | IOError -> Bool
isDoesNotExistError IOError
ioe ->
                -- see #5987 on reason for takeFileName
                forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
tp)
             PandocError
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
tp

-- | Get default template for the specified writer.
getDefaultTemplate :: PandocMonad m
                   => Text           -- ^ Name of writer
                   -> m Text
getDefaultTemplate :: forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
format = do
  case Text
format of
       Text
"native"  -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"csljson" -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"json"    -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"docx"    -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"fb2"     -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"pptx"    -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"ipynb"   -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
       Text
"asciidoctor" -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"asciidoc"
       Text
"asciidoc_legacy" -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"asciidoc"
       Text
"odt"     -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"opendocument"
       Text
"html"    -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"html5"
       Text
"docbook" -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"docbook5"
       Text
"epub"    -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"epub3"
       Text
"beamer"  -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"latex"
       Text
"jats"    -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"jats_archiving"
       Text
"markdown_strict"   -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
       Text
"multimarkdown"     -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
       Text
"markdown_github"   -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
       Text
"markdown_mmd"      -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
       Text
"markdown_phpextra" -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
       Text
"gfm"               -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"commonmark"
       Text
"commonmark_x"      -> forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"commonmark"
       Text
_        -> do
         let fname :: FilePath
fname = FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath
"default" FilePath -> FilePath -> FilePath
<.> Text -> FilePath
T.unpack Text
format
         forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
fname forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fname

-- | Get and compile default template for the specified writer.
-- Raise an error on compilation failure.
compileDefaultTemplate :: PandocMonad m
                       => Text
                       -> m (Template Text)
compileDefaultTemplate :: forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
compileDefaultTemplate Text
writer = do
  Either FilePath (Template Text)
res <- forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
writer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate (FilePath
"templates/default." forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
writer)
  case Either FilePath (Template Text)
res of
    Left FilePath
e   -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocTemplateError (FilePath -> Text
T.pack FilePath
e)
    Right Template Text
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t