{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
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)
newtype WithDefaultPartials m a = WithDefaultPartials { forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials :: m a }
deriving ((forall a b.
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b)
-> (forall a b.
a -> WithDefaultPartials m b -> WithDefaultPartials m a)
-> Functor (WithDefaultPartials m)
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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
fmap :: forall a b.
(a -> b) -> WithDefaultPartials m a -> WithDefaultPartials m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithDefaultPartials m b -> WithDefaultPartials m a
<$ :: forall a b. a -> WithDefaultPartials m b -> WithDefaultPartials m a
Functor, Functor (WithDefaultPartials m)
Functor (WithDefaultPartials m) =>
(forall a. a -> WithDefaultPartials m a)
-> (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 a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b)
-> (forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a)
-> Applicative (WithDefaultPartials m)
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
$cpure :: forall (m :: * -> *) a.
Applicative m =>
a -> WithDefaultPartials m a
pure :: forall a. a -> WithDefaultPartials m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
<*> :: forall a b.
WithDefaultPartials m (a -> b)
-> WithDefaultPartials m a -> WithDefaultPartials m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
liftA2 :: forall a b c.
(a -> b -> c)
-> WithDefaultPartials m a
-> WithDefaultPartials m b
-> WithDefaultPartials m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
*> :: 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 a
<* :: forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m a
Applicative, Applicative (WithDefaultPartials m)
Applicative (WithDefaultPartials m) =>
(forall a b.
WithDefaultPartials m a
-> (a -> WithDefaultPartials m b) -> WithDefaultPartials m b)
-> (forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b)
-> (forall a. a -> WithDefaultPartials m a)
-> Monad (WithDefaultPartials m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithDefaultPartials m a
-> (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
-> WithDefaultPartials m b -> WithDefaultPartials m b
>> :: forall a b.
WithDefaultPartials m a
-> WithDefaultPartials m b -> WithDefaultPartials m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithDefaultPartials m a
return :: forall a. a -> WithDefaultPartials m a
Monad)
newtype WithPartials m a = WithPartials { forall (m :: * -> *) a. WithPartials m a -> m a
runWithPartials :: m a }
deriving ((forall a b. (a -> b) -> WithPartials m a -> WithPartials m b)
-> (forall a b. a -> WithPartials m b -> WithPartials m a)
-> Functor (WithPartials m)
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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithPartials m a -> WithPartials m b
fmap :: forall a b. (a -> b) -> WithPartials m a -> WithPartials m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithPartials m b -> WithPartials m a
<$ :: forall a b. a -> WithPartials m b -> WithPartials m a
Functor, Functor (WithPartials m)
Functor (WithPartials m) =>
(forall a. a -> WithPartials m a)
-> (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 a b.
WithPartials m a -> WithPartials m b -> WithPartials m b)
-> (forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m a)
-> Applicative (WithPartials m)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> WithPartials m a
pure :: forall a. a -> WithPartials m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
<*> :: forall a b.
WithPartials m (a -> b) -> WithPartials m a -> WithPartials m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
liftA2 :: forall a b c.
(a -> b -> c)
-> WithPartials m a -> WithPartials m b -> WithPartials m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithPartials m a -> WithPartials m b -> WithPartials m b
*> :: 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 a
<* :: forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m a
Applicative, Applicative (WithPartials m)
Applicative (WithPartials m) =>
(forall a b.
WithPartials m a -> (a -> WithPartials m b) -> WithPartials m b)
-> (forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b)
-> (forall a. a -> WithPartials m a)
-> Monad (WithPartials m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithPartials m a -> (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 -> WithPartials m b -> WithPartials m b
>> :: forall a b.
WithPartials m a -> WithPartials m b -> WithPartials m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithPartials m a
return :: forall a. a -> WithPartials m a
Monad)
instance PandocMonad m => TemplateMonad (WithDefaultPartials m) where
getPartial :: FilePath -> WithDefaultPartials m Text
getPartial FilePath
fp = m Text -> WithDefaultPartials m Text
forall (m :: * -> *) a. m a -> WithDefaultPartials m a
WithDefaultPartials (m Text -> WithDefaultPartials m Text)
-> m Text -> WithDefaultPartials m Text
forall a b. (a -> b) -> a -> b
$
FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
fp) m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
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 = m Text -> WithPartials m Text
forall (m :: * -> *) a. m a -> WithPartials m a
WithPartials (m Text -> WithPartials m Text) -> m Text -> WithPartials m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> m Text
forall (m :: * -> *). PandocMonad m => FilePath -> m Text
getTemplate FilePath
fp
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 (CommonState -> Maybe Text) -> m CommonState -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
(CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{
stSourceURL = Nothing }
(ByteString
bs, Maybe Text
_) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem (Text -> m (ByteString, Maybe Text))
-> Text -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
tp
(CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{
stSourceURL = surl }
ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs)
m ByteString -> (PandocError -> m ByteString) -> m ByteString
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError`
(\PandocError
e -> case PandocError
e of
PandocResourceNotFound Text
_ ->
FilePath -> m ByteString
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 ->
FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile (FilePath
"templates" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
tp)
PandocError
_ -> PandocError -> m ByteString
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)) m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
tp
getDefaultTemplate :: PandocMonad m
=> Text
-> m Text
getDefaultTemplate :: forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
format = do
case Text
format of
Text
"native" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"csljson" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"json" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"fb2" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"pptx" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"ipynb" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Text
"asciidoctor" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"asciidoc"
Text
"asciidoc_legacy" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"asciidoc"
Text
"docx" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"openxml"
Text
"odt" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"opendocument"
Text
"html" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"html5"
Text
"docbook" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"docbook5"
Text
"epub" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"epub3"
Text
"beamer" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"latex"
Text
"jats" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"jats_archiving"
Text
"markdown_strict" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
Text
"multimarkdown" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
Text
"markdown_github" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
Text
"markdown_mmd" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
Text
"markdown_phpextra" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"markdown"
Text
"gfm" -> Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
"commonmark"
Text
"commonmark_x" -> Text -> m Text
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
FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
fname m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fname
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 <- Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
getDefaultTemplate Text
writer m Text
-> (Text -> m (Either FilePath (Template Text)))
-> m (Either FilePath (Template Text))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
WithDefaultPartials m (Either FilePath (Template Text))
-> m (Either FilePath (Template Text))
forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials (WithDefaultPartials m (Either FilePath (Template Text))
-> m (Either FilePath (Template Text)))
-> (Text
-> WithDefaultPartials m (Either FilePath (Template Text)))
-> Text
-> m (Either FilePath (Template Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath
-> Text -> WithDefaultPartials m (Either FilePath (Template Text))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate (FilePath
"templates/default." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
writer)
case Either FilePath (Template Text)
res of
Left FilePath
e -> PandocError -> m (Template Text)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Template Text))
-> PandocError -> m (Template Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocTemplateError (FilePath -> Text
T.pack FilePath
e)
Right Template Text
t -> Template Text -> m (Template Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t