    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE DeriveGeneric     #-}
    {-# LANGUAGE TemplateHaskell   #-}
    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Filter
       Copyright   : Copyright (C) 2006-2020 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.PandocIO (PandocIO)
    import Text.Pandoc.Class.PandocMonad (report, getVerbosity)
    import Text.Pandoc.Definition (Pandoc)
    import Text.Pandoc.Options (ReaderOptions)
    import Text.Pandoc.Logging
    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
                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 :: Node Pos
    node =
      (String
    -> (Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter
    forall a.
    String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
    withMap "Filter" ((Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter)
    -> (Mapping Pos -> Parser Filter) -> Node Pos -> Parser Filter
    forall a b. (a -> b) -> a -> b
    $ \m :: Mapping Pos
    m -> do
        Text
    ty <- Mapping Pos
    m Mapping Pos -> Text -> Parser Text
    forall a. FromYAML a => Mapping Pos -> Text -> Parser a
    .: "type"
        Text
    fp <- Mapping Pos
    m Mapping Pos -> Text -> Parser Text
    forall a. FromYAML a => Mapping Pos -> Text -> Parser a
    .: "path"
        case Text
    ty of
          "lua"  -> 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
    $ String -> Filter
    LuaFilter (String -> Filter) -> String -> Filter
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    fp
          "json" -> 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
    $ String -> Filter
    JSONFilter (String -> Filter) -> String -> Filter
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack 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)) 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 "Filter" ((Text -> Parser Filter) -> Node Pos -> Parser Filter)
    -> (Text -> Parser Filter) -> Node Pos -> Parser Filter
    forall a b. (a -> b) -> a -> b
    $ \t :: Text
    t -> do
        let fp :: String
    fp = Text -> String
    T.unpack Text
    t
        case ShowS
    takeExtension String
    fp of
          ".lua"  -> 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
    $ String -> Filter
    LuaFilter String
    fp
          _       -> 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
    $ String -> Filter
    JSONFilter String
    fp) Node Pos
    node

    -- | Modify the given document using a filter.
    applyFilters :: ReaderOptions
                 -> [Filter]
                 -> [String]
                 -> Pandoc
                 -> PandocIO Pandoc
    applyFilters :: ReaderOptions -> [Filter] -> [String] -> Pandoc -> PandocIO Pandoc
    applyFilters ropts :: ReaderOptions
    ropts filters :: [Filter]
    filters args :: [String]
    args d :: Pandoc
    d = do
      [Filter]
    expandedFilters <- (Filter -> PandocIO Filter) -> [Filter] -> PandocIO [Filter]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Filter -> PandocIO Filter
    expandFilterPath [Filter]
    filters
      (Pandoc -> Filter -> PandocIO Pandoc)
    -> Pandoc -> [Filter] -> PandocIO Pandoc
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Pandoc -> Filter -> PandocIO Pandoc
    applyFilter Pandoc
    d [Filter]
    expandedFilters
     where
      applyFilter :: Pandoc -> Filter -> PandocIO Pandoc
    applyFilter doc :: Pandoc
    doc (JSONFilter f :: String
    f) =
        String -> PandocIO Pandoc -> PandocIO Pandoc
    forall (m :: * -> *) b.
    (PandocMonad m, MonadIO m) =>
    String -> m b -> m b
    withMessages String
    f (PandocIO Pandoc -> PandocIO Pandoc)
    -> PandocIO Pandoc -> PandocIO Pandoc
    forall a b. (a -> b) -> a -> b
    $ ReaderOptions -> [String] -> String -> Pandoc -> PandocIO Pandoc
    JSONFilter.apply ReaderOptions
    ropts [String]
    args String
    f Pandoc
    doc
      applyFilter doc :: Pandoc
    doc (LuaFilter f :: String
    f)  =
        String -> PandocIO Pandoc -> PandocIO Pandoc
    forall (m :: * -> *) b.
    (PandocMonad m, MonadIO m) =>
    String -> m b -> m b
    withMessages String
    f (PandocIO Pandoc -> PandocIO Pandoc)
    -> PandocIO Pandoc -> PandocIO Pandoc
    forall a b. (a -> b) -> a -> b
    $ ReaderOptions -> [String] -> String -> Pandoc -> PandocIO Pandoc
    LuaFilter.apply ReaderOptions
    ropts [String]
    args String
    f 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 :: Filter -> PandocIO Filter
    expandFilterPath :: Filter -> PandocIO Filter
    expandFilterPath (LuaFilter fp :: String
    fp) = String -> Filter
    LuaFilter (String -> Filter) -> PandocIO String -> PandocIO Filter
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> PandocIO String
    forall (m :: * -> *). PandocMonad m => String -> m String
    Path.expandFilterPath String
    fp
    expandFilterPath (JSONFilter fp :: String
    fp) = String -> Filter
    JSONFilter (String -> Filter) -> PandocIO String -> PandocIO Filter
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> PandocIO String
    forall (m :: * -> *). PandocMonad m => String -> m String
    Path.expandFilterPath String
    fp

    $(deriveJSON defaultOptions ''Filter)