{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, 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
$cto :: forall x. Rep Filter x -> Filter
$cfrom :: forall x. Filter -> Rep Filter x
Generic)

instance FromJSON Filter where
 parseJSON :: Value -> Parser Filter
parseJSON Value
node =
  (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Filter" forall a b. (a -> b) -> a -> b
$ \Object
m -> do
    Text
ty <- Object
m forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Text
fp <- Object
m forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
    let missingPath :: Parser a
missingPath = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected 'path' for filter of type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
ty
    let filterWithPath :: (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> a
constr = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. Parser a
missingPath (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
constr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
    case Text
ty of
      Text
"citeproc" -> forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
      Text
"lua"  -> forall {a}. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
LuaFilter Maybe Text
fp
      Text
"json" -> forall {a}. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
JSONFilter Maybe Text
fp
      Text
_      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown filter type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Text
ty :: T.Text)) Value
node
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Filter" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    let fp :: String
fp = Text -> String
T.unpack Text
t
    if String
fp forall a. Eq a => a -> a -> Bool
== String
"citeproc"
       then forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
       else forall (m :: * -> *) a. Monad m => a -> m a
return 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"citeproc" ]
 toJSON (LuaFilter String
fp) = [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"lua",
                                  Key
"path" 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"json",
                                   Key
"path" 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Filter -> m Filter
expandFilterPath [Filter]
filters
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM 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) =
    forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
f forall a b. (a -> b) -> a -> b
$ 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)  =
    forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
f 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 =
    forall {m :: * -> *} {b}.
(PandocMonad m, MonadIO m) =>
String -> m b -> m b
withMessages String
"citeproc" forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
INFO) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ String -> LogMessage
RunningFilter String
f
    Integer
starttime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    b
res <- m b
action
    Integer
endtime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
INFO) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ String -> Integer -> LogMessage
FilterCompleted String
f forall a b. (a -> b) -> a -> b
$ forall {a}. Integral a => a -> a
toMilliseconds forall a b. (a -> b) -> a -> b
$ Integer
endtime forall a. Num a => a -> a -> a
- Integer
starttime
    forall (m :: * -> *) a. Monad m => a -> m a
return b
res
  toMilliseconds :: a -> a
toMilliseconds a
picoseconds = a
picoseconds 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => String -> m String
filterPath String
fp
expandFilterPath (JSONFilter String
fp) = String -> Filter
JSONFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => String -> m String
filterPath String
fp
expandFilterPath Filter
CiteprocFilter = 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 = forall a. a -> Maybe a -> a
fromMaybe String
fp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *).
MonadIO m =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
JSONFilter.apply