{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
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)
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
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
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)