    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE DeriveGeneric     #-}
    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Filter
       Copyright   : Copyright (C) 2006-2024 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, Filter -> Filter -> Bool
    (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Bool) -> Eq Filter
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Filter -> Filter -> Bool
    == :: Filter -> Filter -> Bool
    $c/= :: Filter -> Filter -> Bool
    /= :: Filter -> Filter -> Bool
    Eq)

    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) ]

    -- | 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
      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

    -- | 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