{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Templates
   Copyright   : Copyright (C) 2009-2022 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.
-}

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, readDataFile, fetchItem,
                                      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
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
$
    ByteString -> Text
UTF8.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName 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 = ByteString -> Text
UTF8.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ((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))

-- | 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
writer = do
  let format :: Text
format = (Char -> Bool) -> Text -> Text
T.takeWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (FilePath
"+-" :: String)) Text
writer  -- strip off extensions
  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
"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
         ByteString -> Text
UTF8.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile 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