{-# 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, 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)
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)
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
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
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
_ ->
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 ->
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))
getDefaultTemplate :: PandocMonad m
=> Text
-> 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
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
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