Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Move filter functions to separate module

Browse source
This commit is contained in:
Albert Krewinkel 2018-01-10 22:26:12 +01:00
parent f130109b90
commit 5d49cbd35e
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
6 changed files with 273 additions and 96 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
pandoc.cabal
View file

@ -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,

100
src/Text/Pandoc/App.hs
View file

@ -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)

60
src/Text/Pandoc/Filter.hs Normal file
View file

@ -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)

97
src/Text/Pandoc/Filter/Json.hs Normal file
View file

@ -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)

53
src/Text/Pandoc/Filter/Lua.hs Normal file
View file

@ -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)

53
src/Text/Pandoc/Filter/Path.hs Normal file
View file

@ -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