{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter
( Filter (..)
, Environment (..)
, applyFilters
, applyJSONFilter
) where
import System.CPUTime (getCPUTime)
import Data.Aeson
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback, getVerbosity,
report)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Filter.Environment (Environment (..))
import Text.Pandoc.Logging
import Text.Pandoc.Citeproc (processCitations)
import Text.Pandoc.Scripting (ScriptingEngine (engineApplyFilter))
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Data.Text as T
import System.FilePath (takeExtension)
import Control.Applicative ((<|>))
import Control.Monad.Trans (MonadIO (liftIO))
import Control.Monad (foldM, when)
data Filter = LuaFilter FilePath
| JSONFilter FilePath
| CiteprocFilter
deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show, (forall x. Filter -> Rep Filter x)
-> (forall x. Rep Filter x -> Filter) -> Generic Filter
forall x. Rep Filter x -> Filter
forall x. Filter -> Rep Filter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Filter -> Rep Filter x
from :: forall x. Filter -> Rep Filter x
$cto :: forall x. Rep Filter x -> Filter
to :: forall x. Rep Filter x -> Filter
Generic)
instance FromJSON Filter where
parseJSON :: Value -> Parser Filter
parseJSON Value
node =
(String -> (Object -> Parser Filter) -> Value -> Parser Filter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Filter" ((Object -> Parser Filter) -> Value -> Parser Filter)
-> (Object -> Parser Filter) -> Value -> Parser Filter
forall a b. (a -> b) -> a -> b
$ \Object
m -> do
ty <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
fp <- m .:? "path"
let missingPath = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Expected 'path' for filter of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ty
let filterWithPath String -> a
constr = Parser a -> (Text -> Parser a) -> Maybe Text -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall {a}. Parser a
missingPath (a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parser a) -> (Text -> a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
constr (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
case ty of
Text
"citeproc" -> Filter -> Parser Filter
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
Text
"lua" -> (String -> Filter) -> Maybe Text -> Parser Filter
forall {a}. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
LuaFilter Maybe Text
fp
Text
"json" -> (String -> Filter) -> Maybe Text -> Parser Filter
forall {a}. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
JSONFilter Maybe Text
fp
Text
_ -> String -> Parser Filter
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Filter) -> String -> Parser Filter
forall a b. (a -> b) -> a -> b
$ String
"Unknown filter type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Text
ty :: T.Text)) Value
node
Parser Filter -> Parser Filter -> Parser Filter
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(String -> (Text -> Parser Filter) -> Value -> Parser Filter
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Filter" ((Text -> Parser Filter) -> Value -> Parser Filter)
-> (Text -> Parser Filter) -> Value -> Parser Filter
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
let fp :: String
fp = Text -> String
T.unpack Text
t
if String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"citeproc"
then Filter -> Parser Filter
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
else Filter -> Parser Filter
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Filter -> Parser Filter) -> Filter -> Parser Filter
forall a b. (a -> b) -> a -> b
$
case ShowS
takeExtension String
fp of
String
".lua" -> String -> Filter
LuaFilter String
fp
String
_ -> String -> Filter
JSONFilter String
fp) Value
node
instance ToJSON Filter where
toJSON :: Filter -> Value
toJSON Filter
CiteprocFilter = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"citeproc" ]
toJSON (LuaFilter String
fp) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"lua",
Key
"path" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
T.pack String
fp) ]
toJSON (JSONFilter String
fp) = [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"json",
Key
"path" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
T.pack String
fp) ]
applyFilters :: (PandocMonad m, MonadIO m)
=> ScriptingEngine
-> Environment
-> [Filter]
-> [String]
-> Pandoc
-> m Pandoc
applyFilters :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
ScriptingEngine
-> Environment -> [Filter] -> [String] -> Pandoc -> m Pandoc
applyFilters ScriptingEngine
scrngin Environment
fenv [Filter]
filters [String]
args Pandoc
d = do
expandedFilters <- (Filter -> m Filter) -> [Filter] -> m [Filter]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Filter -> m Filter
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Filter -> m Filter
expandFilterPath [Filter]
filters
foldM applyFilter d expandedFilters
where
applyFilter :: Pandoc -> Filter -> m Pandoc
applyFilter Pandoc
doc (JSONFilter String
f) =
String -> m Pandoc -> m Pandoc
forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
f (m Pandoc -> m Pandoc) -> m Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Environment -> [String] -> String -> Pandoc -> m Pandoc
forall (m :: * -> *).
MonadIO m =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
JSONFilter.apply Environment
fenv [String]
args String
f Pandoc
doc
applyFilter Pandoc
doc (LuaFilter String
f) =
String -> m Pandoc -> m Pandoc
forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
f (m Pandoc -> m Pandoc) -> m Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ ScriptingEngine
-> forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
engineApplyFilter ScriptingEngine
scrngin Environment
fenv [String]
args String
f Pandoc
doc
applyFilter Pandoc
doc Filter
CiteprocFilter =
String -> m Pandoc -> m Pandoc
forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
"citeproc" (m Pandoc -> m Pandoc) -> m Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Pandoc -> m Pandoc
forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
processCitations Pandoc
doc
withMessages :: String -> m b -> m b
withMessages String
f m b
action = do
verbosity <- m Verbosity
forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity
when (verbosity == INFO) $ report $ RunningFilter f
starttime <- liftIO getCPUTime
res <- action
endtime <- liftIO getCPUTime
when (verbosity == INFO) $ report $ FilterCompleted f $ toMilliseconds $ endtime - starttime
return res
toMilliseconds :: a -> a
toMilliseconds a
picoseconds = a
picoseconds a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1000000000
expandFilterPath :: (PandocMonad m, MonadIO m) => Filter -> m Filter
expandFilterPath :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Filter -> m Filter
expandFilterPath (LuaFilter String
fp) = String -> Filter
LuaFilter (String -> Filter) -> m String -> m Filter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
filterPath String
fp
expandFilterPath (JSONFilter String
fp) = String -> Filter
JSONFilter (String -> Filter) -> m String -> m Filter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
filterPath String
fp
expandFilterPath Filter
CiteprocFilter = Filter -> m Filter
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
filterPath :: PandocMonad m => FilePath -> m FilePath
filterPath :: forall (m :: * -> *). PandocMonad m => String -> m String
filterPath String
fp = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
fp (Maybe String -> String) -> m (Maybe String) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> m (Maybe String)
forall (m :: * -> *).
PandocMonad m =>
String -> String -> m (Maybe String)
findFileWithDataFallback String
"filters" String
fp
applyJSONFilter :: MonadIO m
=> Environment
-> [String]
-> FilePath
-> Pandoc
-> m Pandoc
applyJSONFilter :: forall (m :: * -> *).
MonadIO m =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
applyJSONFilter = Environment -> [String] -> String -> Pandoc -> m Pandoc
forall (m :: * -> *).
MonadIO m =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
JSONFilter.apply