{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Filter
( Filter (..)
, applyFilters
) where
import Prelude
import Data.Aeson.TH (deriveJSON, defaultOptions)
import GHC.Generics (Generic)
import Text.Pandoc.Class (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Options (ReaderOptions)
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 (foldM)
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) = ReaderOptions -> [String] -> String -> Pandoc -> PandocIO Pandoc
JSONFilter.apply ReaderOptions
ropts [String]
args String
f Pandoc
doc
applyFilter doc :: Pandoc
doc (LuaFilter f :: String
f) = ReaderOptions -> [String] -> String -> Pandoc -> PandocIO Pandoc
LuaFilter.apply ReaderOptions
ropts [String]
args String
f Pandoc
doc
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)