{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Filter
   Copyright   : Copyright (C) 2006-2022 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
  ) where

import System.CPUTime (getCPUTime)
import Data.Aeson
import GHC.Generics (Generic)
import Text.Pandoc.Class (report, getVerbosity, PandocMonad)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Filter.Environment (Environment (..))
import Text.Pandoc.Logging
import Text.Pandoc.Citeproc (processCitations)
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Filter.Lua as LuaFilter
import qualified Text.Pandoc.Filter.Path as Path
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
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Filter x -> Filter
$cfrom :: forall x. Filter -> Rep Filter x
Generic)

instance FromJSON Filter where
 parseJSON :: Value -> Parser Filter
parseJSON node :: Value
node =
  (String -> (Object -> Parser Filter) -> Value -> Parser Filter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Filter" ((Object -> Parser Filter) -> Value -> Parser Filter)
-> (Object -> Parser Filter) -> Value -> Parser Filter
forall a b. (a -> b) -> a -> b
$ \m :: Object
m -> do
    Text
ty <- Object
m Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: "type"
    Maybe Text
fp <- Object
m Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? "path"
    let missingPath :: Parser a
missingPath = 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
$ "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 constr :: 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 (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
      "citeproc" -> Filter -> Parser Filter
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
      "lua"  -> (String -> Filter) -> Maybe Text -> Parser Filter
forall a. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
LuaFilter Maybe Text
fp
      "json" -> (String -> Filter) -> Maybe Text -> Parser Filter
forall a. (String -> a) -> Maybe Text -> Parser a
filterWithPath String -> Filter
JSONFilter Maybe Text
fp
      _      -> String -> Parser Filter
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Filter) -> String -> Parser Filter
forall a b. (a -> b) -> a -> b
$ "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 (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 "Filter" ((Text -> Parser Filter) -> Value -> Parser Filter)
-> (Text -> Parser Filter) -> Value -> Parser Filter
forall a b. (a -> b) -> a -> b
$ \t :: 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
== "citeproc"
       then Filter -> Parser Filter
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter
       else Filter -> Parser Filter
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
           ".lua"  -> String -> Filter
LuaFilter String
fp
           _       -> String -> Filter
JSONFilter String
fp) Value
node

instance ToJSON Filter where
 toJSON :: Filter -> Value
toJSON CiteprocFilter = [Pair] -> Value
object [ "type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String "citeproc" ]
 toJSON (LuaFilter fp :: String
fp) = [Pair] -> Value
object [ "type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String "lua",
                                  "path" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (String -> Text
T.pack String
fp) ]
 toJSON (JSONFilter fp :: String
fp) = [Pair] -> Value
object [ "type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String "json",
                                   "path" Key -> Value -> 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)
             => Environment
             -> [Filter]
             -> [String]
             -> Pandoc
             -> m Pandoc
applyFilters :: Environment -> [Filter] -> [String] -> Pandoc -> m Pandoc
applyFilters fenv :: Environment
fenv filters :: [Filter]
filters args :: [String]
args d :: 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)
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 doc :: Pandoc
doc (JSONFilter f :: 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 doc :: Pandoc
doc (LuaFilter f :: 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 :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [String] -> String -> Pandoc -> m Pandoc
LuaFilter.apply Environment
fenv [String]
args String
f Pandoc
doc
  applyFilter doc :: Pandoc
doc CiteprocFilter =
    Pandoc -> m Pandoc
forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
processCitations Pandoc
doc
  withMessages :: String -> m b -> m b
withMessages f :: String
f action :: 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
    b
res <- m b
action
    Integer
endtime <- IO Integer -> m Integer
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 (m :: * -> *) a. Monad m => a -> m a
return b
res
  toMilliseconds :: a -> a
toMilliseconds picoseconds :: a
picoseconds = a
picoseconds a -> a -> a
forall a. Integral a => a -> a -> a
`div` 1000000000

-- | Expand paths of filters, searching the data directory.
expandFilterPath :: (PandocMonad m, MonadIO m) => Filter -> m Filter
expandFilterPath :: Filter -> m Filter
expandFilterPath (LuaFilter fp :: 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
Path.expandFilterPath String
fp
expandFilterPath (JSONFilter fp :: 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
Path.expandFilterPath String
fp
expandFilterPath CiteprocFilter = Filter -> m Filter
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter