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

import System.CPUTime (getCPUTime)
import Data.Aeson.TH (deriveJSON, defaultOptions)
import GHC.Generics (Generic)
import Text.Pandoc.Class (report, getVerbosity, PandocMonad)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Options (ReaderOptions)
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 Data.YAML
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 FromYAML Filter where
 parseYAML :: Node Pos -> Parser Filter
parseYAML Node Pos
node =
  (String
-> (Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap String
"Filter" ((Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter)
-> (Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
    Text
ty <- Mapping Pos
m Mapping Pos -> Text -> Parser Text
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"type"
    Maybe Text
fp <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe Text)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"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
$ 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 (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 (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 (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)) Node Pos
node
  Parser Filter -> Parser Filter -> Parser Filter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (String -> (Text -> Parser Filter) -> Node Pos -> Parser Filter
forall a. String -> (Text -> Parser a) -> Node Pos -> Parser a
withStr String
"Filter" ((Text -> Parser Filter) -> Node Pos -> Parser Filter)
-> (Text -> Parser Filter) -> Node Pos -> 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 (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
           String
".lua"  -> String -> Filter
LuaFilter String
fp
           String
_       -> String -> Filter
JSONFilter String
fp) Node Pos
node

-- | Modify the given document using a filter.
applyFilters :: (PandocMonad m, MonadIO m)
             => ReaderOptions
             -> [Filter]
             -> [String]
             -> Pandoc
             -> m Pandoc
applyFilters :: ReaderOptions -> [Filter] -> [String] -> Pandoc -> m Pandoc
applyFilters ReaderOptions
ropts [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)
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
$ ReaderOptions -> [String] -> String -> Pandoc -> m Pandoc
forall (m :: * -> *).
MonadIO m =>
ReaderOptions -> [String] -> String -> Pandoc -> m Pandoc
JSONFilter.apply ReaderOptions
ropts [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
$ ReaderOptions -> [String] -> String -> Pandoc -> m Pandoc
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
ReaderOptions -> [String] -> String -> Pandoc -> m Pandoc
LuaFilter.apply ReaderOptions
ropts [String]
args String
f Pandoc
doc
  applyFilter Pandoc
doc Filter
CiteprocFilter =
    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 (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 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 :: 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
Path.expandFilterPath 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
Path.expandFilterPath String
fp
expandFilterPath Filter
CiteprocFilter = Filter -> m Filter
forall (m :: * -> *) a. Monad m => a -> m a
return Filter
CiteprocFilter

$(deriveJSON defaultOptions ''Filter)