{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Filter
   Copyright   : Copyright (C) 2006-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Programmatically modifications of pandoc documents.
-}
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)

-- | Type of filter and path to filter file.
data Filter = LuaFilter FilePath
            | JSONFilter FilePath
            | CiteprocFilter -- built-in citeproc
            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
    Text
ty <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Text
fp <- Object
m Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
    let missingPath :: Parser a
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) -> Maybe Text -> Parser a
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 Text
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 kv v. (KeyValue 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"lua",
                                  Key
"path" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"json",
                                   Key
"path" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
T.pack String
fp) ]

-- | Modify the given document using a filter.
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
  [Filter]
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
  (Pandoc -> Filter -> m Pandoc) -> Pandoc -> [Filter] -> m Pandoc
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Pandoc -> Filter -> m Pandoc
forall {m :: * -> *}.
(PandocMonad m, MonadIO m) =>
Pandoc -> Filter -> m Pandoc
applyFilter Pandoc
d [Filter]
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
verbosity <- m Verbosity
forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
INFO) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ String -> LogMessage
RunningFilter String
f
    Integer
starttime <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    b
res <- m b
action
    Integer
endtime <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
INFO) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Integer -> LogMessage
FilterCompleted String
f (Integer -> LogMessage) -> Integer -> LogMessage
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall {a}. Integral a => a -> a
toMilliseconds (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
endtime Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
starttime
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
  toMilliseconds :: a -> a
toMilliseconds a
picoseconds = a
picoseconds a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
1000000000

-- | Expand paths of filters, searching the data directory.
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