diff options
| -rw-r--r-- | pandoc.cabal | 6 | ||||
| -rw-r--r-- | src/Text/Pandoc/App.hs | 100 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter.hs | 60 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter/Json.hs | 97 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter/Lua.hs | 53 | ||||
| -rw-r--r-- | src/Text/Pandoc/Filter/Path.hs | 53 |
6 files changed, 273 insertions, 96 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index dedeaaeca..019a2f102 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -501,7 +501,11 @@ library Text.Pandoc.ImageSize, Text.Pandoc.BCP47, Text.Pandoc.Class - other-modules: Text.Pandoc.Readers.Docx.Lists, + other-modules: Text.Pandoc.Filter, + Text.Pandoc.Filter.Json, + Text.Pandoc.Filter.Lua, + Text.Pandoc.Filter.Path, + Text.Pandoc.Readers.Docx.Lists, Text.Pandoc.Readers.Docx.Combine, Text.Pandoc.Readers.Docx.Parse, Text.Pandoc.Readers.Docx.Util, diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 976311e77..26c754cd6 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -46,12 +46,11 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.Except (catchError, throwError) import Control.Monad.Trans -import Data.Aeson (defaultOptions, eitherDecode', encode) +import Data.Aeson (defaultOptions) import Data.Aeson.TH (deriveJSON) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import Data.Char (toLower, toUpper) -import Data.Foldable (foldrM) import Data.List (find, intercalate, isPrefixOf, isSuffixOf, sort) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, isNothing) @@ -73,10 +72,9 @@ import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme, pygments) import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) import System.Console.GetOpt -import System.Directory (Permissions (..), doesFileExist, findExecutable, - getAppUserDataDirectory, getPermissions) -import System.Environment (getArgs, getEnvironment, getProgName) -import System.Exit (ExitCode (..), exitSuccess) +import System.Directory (getAppUserDataDirectory) +import System.Environment (getArgs, getProgName) +import System.Exit (exitSuccess) import System.FilePath import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) @@ -84,10 +82,9 @@ import System.IO.Error (isDoesNotExistError) import Text.Pandoc import Text.Pandoc.BCP47 (Lang (..), parseBCP47) import Text.Pandoc.Builder (setMeta, deleteMeta) +import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters) import Text.Pandoc.Highlighting (highlightingStyles) -import Text.Pandoc.Lua (LuaException (..), runLuaFilter) import Text.Pandoc.PDF (makePDF) -import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.SelfContained (makeDataURI, makeSelfContained) import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs, headerShift, isURI, ordNub, safeRead, tabFilter) @@ -538,48 +535,6 @@ type Transform = Pandoc -> Pandoc isTextFormat :: String -> Bool isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx"] -externalFilter :: MonadIO m - => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc -externalFilter ropts f args' d = liftIO $ do - exists <- doesFileExist f - isExecutable <- if exists - then executable <$> getPermissions f - else return True - let (f', args'') = if exists - then case map toLower (takeExtension f) of - _ | isExecutable -> ("." </> f, args') - ".py" -> ("python", f:args') - ".hs" -> ("runhaskell", f:args') - ".pl" -> ("perl", f:args') - ".rb" -> ("ruby", f:args') - ".php" -> ("php", f:args') - ".js" -> ("node", f:args') - ".r" -> ("Rscript", f:args') - _ -> (f, args') - else (f, args') - unless (exists && isExecutable) $ do - mbExe <- findExecutable f' - when (isNothing mbExe) $ - E.throwIO $ PandocFilterError f ("Could not find executable " ++ f') - env <- getEnvironment - let env' = Just - ( ("PANDOC_VERSION", pandocVersion) - : ("PANDOC_READER_OPTIONS", UTF8.toStringLazy (encode ropts)) - : env ) - (exitcode, outbs) <- E.handle filterException $ - pipeProcess env' f' args'' $ encode d - case exitcode of - ExitSuccess -> either (E.throwIO . PandocFilterError f) - return $ eitherDecode' outbs - ExitFailure ec -> E.throwIO $ PandocFilterError f - ("Filter returned error status " ++ show ec) - where filterException :: E.SomeException -> IO a - filterException e = E.throwIO $ PandocFilterError f (show e) - -data Filter = LuaFilter FilePath - | JSONFilter FilePath - deriving (Show) - -- | Data structure for command line options. data Opt = Opt { optTabStop :: Int -- ^ Number of spaces per tab @@ -824,50 +779,6 @@ defaultWriterName x = applyTransforms :: Monad m => [Transform] -> Pandoc -> m Pandoc applyTransforms transforms d = return $ foldr ($) d transforms - -- First we check to see if a filter is found. If not, and if it's - -- not an absolute path, we check to see whether it's in `userdir/filters`. - -- If not, we leave it unchanged. -expandFilterPath :: PandocMonad m => FilePath -> m FilePath -expandFilterPath fp = do - mbDatadir <- getUserDataDir - fpExists <- fileExists fp - if fpExists - then return fp - else case mbDatadir of - Just datadir | isRelative fp -> do - let filterPath = datadir </> "filters" </> fp - filterPathExists <- fileExists filterPath - if filterPathExists - then return filterPath - else return fp - _ -> return fp - -applyFilters :: ReaderOptions - -> [Filter] - -> [String] - -> Pandoc - -> PandocIO Pandoc -applyFilters ropts filters args d = do - foldrM ($) d $ map (applyFilter ropts args) filters - -applyFilter :: ReaderOptions - -> [String] - -> Filter - -> Pandoc - -> PandocIO Pandoc -applyFilter ropts args (LuaFilter f) d = do - f' <- expandFilterPath f - let format = case args of - (x:_) -> x - _ -> error "Format not supplied for lua filter" - res <- runLuaFilter ropts f' format d - case res of - Right x -> return x - Left (LuaException s) -> E.throw (PandocFilterError f s) -applyFilter ropts args (JSONFilter f) d = do - f' <- expandFilterPath f - liftIO $ externalFilter ropts f' args d - readSource :: FilePath -> PandocIO Text readSource "-" = liftIO (UTF8.toText <$> BS.getContents) readSource src = case parseURI src of @@ -1722,5 +1633,4 @@ deprecatedOption o msg = -- see https://github.com/jgm/pandoc/pull/4083 -- using generic deriving caused long compilation times $(deriveJSON defaultOptions ''LineEnding) -$(deriveJSON defaultOptions ''Filter) $(deriveJSON defaultOptions ''Opt) diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs new file mode 100644 index 000000000..30c99cc28 --- /dev/null +++ b/src/Text/Pandoc/Filter.hs @@ -0,0 +1,60 @@ +{- +Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} +{-# LANGUAGE TemplateHaskell #-} + +{- | + Module : Text.Pandoc.Filter + Copyright : Copyright (C) 2006-2017 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 Data.Aeson (defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.Foldable (foldrM) +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 + +data Filter = LuaFilter FilePath + | JSONFilter FilePath + deriving (Show) + +applyFilters :: ReaderOptions + -> [Filter] + -> [String] + -> Pandoc + -> PandocIO Pandoc +applyFilters ropts filters args d = do + foldrM ($) d $ map applyFilter filters + where + applyFilter (JSONFilter f) = JsonFilter.apply ropts args f + applyFilter (LuaFilter f) = LuaFilter.apply ropts args f + +$(deriveJSON defaultOptions ''Filter) diff --git a/src/Text/Pandoc/Filter/Json.hs b/src/Text/Pandoc/Filter/Json.hs new file mode 100644 index 000000000..681c52720 --- /dev/null +++ b/src/Text/Pandoc/Filter/Json.hs @@ -0,0 +1,97 @@ +{- +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Filter + Copyright : Copyright (C) 2006-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley@edu> + Stability : alpha + Portability : portable + +Programmatically modifications of pandoc documents via JSON filters. +-} +module Text.Pandoc.Filter.Json (apply) where + +import Control.Monad (unless, when) +import Control.Monad.Trans (MonadIO (liftIO)) +import Data.Aeson (eitherDecode', encode) +import Data.Char (toLower) +import Data.Maybe (isNothing) +import System.Directory (executable, doesFileExist, findExecutable, + getPermissions) +import System.Environment (getEnvironment) +import System.Exit (ExitCode (..)) +import System.FilePath ((</>), takeExtension) +import Text.Pandoc.Class (PandocIO) +import Text.Pandoc.Error (PandocError (PandocFilterError)) +import Text.Pandoc.Definition (Pandoc) +import Text.Pandoc.Filter.Path (expandFilterPath) +import Text.Pandoc.Options (ReaderOptions) +import Text.Pandoc.Process (pipeProcess) +import Text.Pandoc.Shared (pandocVersion) +import qualified Control.Exception as E +import qualified Text.Pandoc.UTF8 as UTF8 + +apply :: ReaderOptions + -> [String] + -> FilePath + -> Pandoc + -> PandocIO Pandoc +apply ropts args f d = do + f' <- expandFilterPath f + liftIO $ externalFilter ropts f' args d + +externalFilter :: MonadIO m + => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc +externalFilter ropts f args' d = liftIO $ do + exists <- doesFileExist f + isExecutable <- if exists + then executable <$> getPermissions f + else return True + let (f', args'') = if exists + then case map toLower (takeExtension f) of + _ | isExecutable -> ("." </> f, args') + ".py" -> ("python", f:args') + ".hs" -> ("runhaskell", f:args') + ".pl" -> ("perl", f:args') + ".rb" -> ("ruby", f:args') + ".php" -> ("php", f:args') + ".js" -> ("node", f:args') + ".r" -> ("Rscript", f:args') + _ -> (f, args') + else (f, args') + unless (exists && isExecutable) $ do + mbExe <- findExecutable f' + when (isNothing mbExe) $ + E.throwIO $ PandocFilterError f ("Could not find executable " ++ f') + env <- getEnvironment + let env' = Just + ( ("PANDOC_VERSION", pandocVersion) + : ("PANDOC_READER_OPTIONS", UTF8.toStringLazy (encode ropts)) + : env ) + (exitcode, outbs) <- E.handle filterException $ + pipeProcess env' f' args'' $ encode d + case exitcode of + ExitSuccess -> either (E.throwIO . PandocFilterError f) + return $ eitherDecode' outbs + ExitFailure ec -> E.throwIO $ PandocFilterError f + ("Filter returned error status " ++ show ec) + where filterException :: E.SomeException -> IO a + filterException e = E.throwIO $ PandocFilterError f (show e) diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs new file mode 100644 index 000000000..597a31cbc --- /dev/null +++ b/src/Text/Pandoc/Filter/Lua.hs @@ -0,0 +1,53 @@ +{- +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Filter.Lua + Copyright : Copyright (C) 2006-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley@edu> + Stability : alpha + Portability : portable + +Apply Lua filters to modify a pandoc documents programmatically. +-} +module Text.Pandoc.Filter.Lua (apply) where + +import Control.Exception (throw) +import Text.Pandoc.Class (PandocIO) +import Text.Pandoc.Definition (Pandoc) +import Text.Pandoc.Error (PandocError (PandocFilterError)) +import Text.Pandoc.Filter.Path (expandFilterPath) +import Text.Pandoc.Lua (LuaException (..), runLuaFilter) +import Text.Pandoc.Options (ReaderOptions) + +apply :: ReaderOptions + -> [String] + -> FilePath + -> Pandoc + -> PandocIO Pandoc +apply ropts args f d = do + f' <- expandFilterPath f + let format = case args of + (x:_) -> x + _ -> error "Format not supplied for lua filter" + res <- runLuaFilter ropts f' format d + case res of + Right x -> return x + Left (LuaException s) -> throw (PandocFilterError f s) diff --git a/src/Text/Pandoc/Filter/Path.hs b/src/Text/Pandoc/Filter/Path.hs new file mode 100644 index 000000000..8074bcbb7 --- /dev/null +++ b/src/Text/Pandoc/Filter/Path.hs @@ -0,0 +1,53 @@ +{- +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Filter.Path + Copyright : Copyright (C) 2006-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley@edu> + Stability : alpha + Portability : portable + +Expand paths of filters, searching the data directory. +-} +module Text.Pandoc.Filter.Path + ( expandFilterPath + ) where + +import Text.Pandoc.Class (PandocMonad, fileExists, getUserDataDir) +import System.FilePath ((</>), isRelative) + + -- First we check to see if a filter is found. If not, and if it's + -- not an absolute path, we check to see whether it's in `userdir/filters`. + -- If not, we leave it unchanged. +expandFilterPath :: PandocMonad m => FilePath -> m FilePath +expandFilterPath fp = do + mbDatadir <- getUserDataDir + fpExists <- fileExists fp + if fpExists + then return fp + else case mbDatadir of + Just datadir | isRelative fp -> do + let filterPath = datadir </> "filters" </> fp + filterPathExists <- fileExists filterPath + if filterPathExists + then return filterPath + else return fp + _ -> return fp |