Lua filters (#3514)

* Add `--lua-filter` option.  This works like `--filter` but takes pathnames of special lua filters and uses the lua interpreter baked into pandoc, so that no external interpreter is needed.  Note that lua filters are all applied after regular filters, regardless of their position on the command line.
* Add Text.Pandoc.Lua, exporting `runLuaFilter`.  Add `pandoc.lua` to data files.
* Add private module Text.Pandoc.Lua.PandocModule to supply the default lua module.
* Add Tests.Lua to tests.
* Add data/pandoc.lua, the lua module pandoc imports when processing its lua filters.
* Document in MANUAL.txt.

3 files changed, 289 insertions, 0 deletions

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 34eadb6e0..d555f6f5f 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -69,6 +69,7 @@ import Text.Pandoc
 import Text.Pandoc.Builder (setMeta)
 import Text.Pandoc.Class (PandocIO, getLog, withMediaBag)
 import Text.Pandoc.Highlighting (highlightingStyles)
+import Text.Pandoc.Lua ( runLuaFilter )
 import Text.Pandoc.MediaBag (MediaBag, extractMediaBag, mediaDirectory)
 import Text.Pandoc.PDF (makePDF)
 import Text.Pandoc.Process (pipeProcess)
@@ -389,6 +390,7 @@ convertWithOpts opts = do
     doc' <- (maybe return (extractMedia media) (optExtractMedia opts) >=>
               return . flip (foldr addMetadata) (optMetadata opts) >=>
               applyTransforms transforms >=>
+              applyLuaFilters datadir (optLuaFilters opts) [format] >=>
               applyFilters datadir filters' [format]) doc
 
     case writer of
@@ -514,6 +516,7 @@ data Opt = Opt
     , optWrapText              :: WrapOption  -- ^ Options for wrapping text
     , optColumns               :: Int     -- ^ Line length in characters
     , optFilters               :: [FilePath] -- ^ Filters to apply
+    , optLuaFilters            :: [FilePath] -- ^ Lua filters to apply
     , optEmailObfuscation      :: ObfuscationMethod
     , optIdentifierPrefix      :: String
     , optIndentedCodeClasses   :: [String] -- ^ Default classes for indented code blocks
@@ -580,6 +583,7 @@ defaultOpts = Opt
     , optWrapText              = WrapAuto
     , optColumns               = 72
     , optFilters               = []
+    , optLuaFilters            = []
     , optEmailObfuscation      = NoObfuscation
     , optIdentifierPrefix      = ""
     , optIndentedCodeClasses   = []
@@ -725,6 +729,12 @@ expandFilterPath mbDatadir fp = liftIO $ do
                     else return fp
                _ -> return fp
 
+applyLuaFilters :: MonadIO m
+                => Maybe FilePath -> [FilePath] -> [String] -> Pandoc -> m Pandoc
+applyLuaFilters mbDatadir filters args d = do
+  expandedFilters <- mapM (expandFilterPath mbDatadir) filters
+  foldrM ($) d $ map (flip runLuaFilter args) expandedFilters
+
 applyFilters :: MonadIO m
              => Maybe FilePath -> [FilePath] -> [String] -> Pandoc -> m Pandoc
 applyFilters mbDatadir filters args d = do
@@ -814,6 +824,12 @@ options =
                   "PROGRAM")
                  "" -- "External JSON filter"
 
+    , Option "" ["lua-filter"]
+                 (ReqArg
+                  (\arg opt -> return opt { optLuaFilters = arg : optLuaFilters opt })
+                  "SCRIPTPATH")
+                 "" -- "Lua filter"
+
     , Option "p" ["preserve-tabs"]
                  (NoArg
                   (\opt -> return opt { optPreserveTabs = True }))
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
new file mode 100644
index 000000000..6fa6b2020
--- /dev/null
+++ b/src/Text/Pandoc/Lua.hs
@@ -0,0 +1,226 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+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 FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+   Module      : Text.Pandoc.Lua
+   Copyright   : Copyright © 2017 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Pandoc lua utils.
+-}
+module Text.Pandoc.Lua ( runLuaFilter ) where
+
+import Control.Monad ( (>=>), when )
+import Control.Monad.Trans ( MonadIO(..) )
+import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
+import Data.HashMap.Lazy ( HashMap )
+import Data.Text ( Text, pack, unpack )
+import Data.Text.Encoding ( decodeUtf8 )
+import Scripting.Lua ( LuaState, StackValue(..) )
+import Scripting.Lua.Aeson ()
+import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
+import Text.Pandoc.Lua.PandocModule
+import Text.Pandoc.Walk
+
+import qualified Data.HashMap.Lazy as HashMap
+import qualified Scripting.Lua as Lua
+import qualified Scripting.Lua as LuaAeson
+
+runLuaFilter :: (MonadIO m)
+             => FilePath -> [String] -> Pandoc -> m Pandoc
+runLuaFilter filterPath args pd = liftIO $ do
+  lua <- LuaAeson.newstate
+  Lua.openlibs lua
+  Lua.newtable lua
+  Lua.setglobal lua "PANDOC_FILTER_FUNCTIONS"  -- hack, store functions here
+  pushPandocModule lua
+  Lua.setglobal lua "pandoc"
+  status <- Lua.loadfile lua filterPath
+  if (status /= 0)
+    then do
+      luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1
+      error luaErrMsg
+    else do
+      Lua.call lua 0 1
+      Just luaFilters <- Lua.peek lua (-1)
+      Lua.push lua (map pack args)
+      Lua.setglobal lua "PandocParameters"
+      doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd
+      Lua.close lua
+      return doc
+
+runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
+runAll [] = return
+runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs
+
+luaFilter :: Lua.LuaState -> String -> Pandoc -> IO Pandoc
+luaFilter lua luaFn x = do
+  fnExists <- isLuaFunction lua luaFn
+  if fnExists
+    then walkM (Lua.callfunc lua luaFn :: Pandoc -> IO Pandoc) x
+    else return x
+
+walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
+walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) =
+  walkM (execInlineLuaFilter lua inlineFnMap) >=>
+  walkM (execBlockLuaFilter  lua blockFnMap)  >=>
+  walkM (execDocLuaFilter    lua docFnMap)
+
+type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline)
+type BlockFunctionMap  = HashMap Text (LuaFilterFunction Block)
+type DocFunctionMap    = HashMap Text (LuaFilterFunction Pandoc)
+data LuaFilter =
+  LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap
+
+newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int }
+
+execDocLuaFilter :: LuaState
+                 -> HashMap Text (LuaFilterFunction Pandoc)
+                 -> Pandoc -> IO Pandoc
+execDocLuaFilter lua fnMap x = do
+  let docFnName = "Doc"
+  case HashMap.lookup docFnName fnMap of
+    Nothing -> return x
+    Just fn -> runLuaFilterFunction lua fn x
+
+execBlockLuaFilter :: LuaState
+                   -> HashMap Text (LuaFilterFunction Block)
+                   -> Block -> IO Block
+execBlockLuaFilter lua fnMap x = do
+  let filterOrId constr = case HashMap.lookup constr fnMap of
+                            Nothing -> return x
+                            Just fn -> runLuaFilterFunction lua fn x
+  case x of
+    Plain _          -> filterOrId "Plain"
+    Para _           -> filterOrId "Para"
+    LineBlock _      -> filterOrId "LineBlock"
+    CodeBlock _ _    -> filterOrId "CodeBlock"
+    RawBlock _ _     -> filterOrId "RawBlock"
+    BlockQuote _     -> filterOrId "BlockQuote"
+    OrderedList _ _  -> filterOrId "OrderedList"
+    BulletList _     -> filterOrId "BulletList"
+    DefinitionList _ -> filterOrId "DefinitionList"
+    Header _ _ _     -> filterOrId "Header"
+    HorizontalRule   -> filterOrId "HorizontalRule"
+    Table _ _ _ _ _  -> filterOrId "Table"
+    Div _ _          -> filterOrId "Div"
+    Null             -> filterOrId "Null"
+
+execInlineLuaFilter :: LuaState
+                    -> HashMap Text (LuaFilterFunction Inline)
+                    -> Inline -> IO Inline
+execInlineLuaFilter lua fnMap x = do
+  let filterOrId constr = case HashMap.lookup constr fnMap of
+                            Nothing -> return x
+                            Just fn -> runLuaFilterFunction lua fn x
+  case x of
+    Cite _ _      -> filterOrId "Cite"
+    Code _ _      -> filterOrId "Code"
+    Emph _        -> filterOrId "Emph"
+    Image _ _ _   -> filterOrId "Image"
+    LineBreak     -> filterOrId "LineBreak"
+    Link _ _ _    -> filterOrId "Link"
+    Math _ _      -> filterOrId "Math"
+    Note _        -> filterOrId "Note"
+    Quoted _ _    -> filterOrId "Quoted"
+    RawInline _ _ -> filterOrId "RawInline"
+    SmallCaps _   -> filterOrId "SmallCaps"
+    SoftBreak     -> filterOrId "SoftBreak"
+    Space         -> filterOrId "Space"
+    Span _ _      -> filterOrId "Span"
+    Str _         -> filterOrId "Str"
+    Strikeout _   -> filterOrId "Strikeout"
+    Strong _      -> filterOrId "Strong"
+    Subscript _   -> filterOrId "Subscript"
+    Superscript _ -> filterOrId "Superscript"
+
+instance StackValue LuaFilter where
+  valuetype _ = Lua.TTABLE
+  push = undefined
+  peek lua i = do
+    -- TODO: find a more efficient way of doing this in a typesafe manner.
+    inlineFnMap <- Lua.peek lua i
+    blockFnMap  <- Lua.peek lua i
+    docFnMap    <- Lua.peek lua i
+    return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap
+
+runLuaFilterFunction :: (StackValue a)
+                     => LuaState -> LuaFilterFunction a -> a -> IO a
+runLuaFilterFunction lua lf inline = do
+  pushFilterFunction lua lf
+  Lua.push lua inline
+  Lua.call lua 1 1
+  Just res <- Lua.peek lua (-1)
+  Lua.pop lua 1
+  return res
+
+-- FIXME: use registry
+pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO ()
+pushFilterFunction lua lf = do
+  Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS"
+  Lua.rawgeti lua (-1) (functionIndex lf)
+  Lua.remove lua (-2) -- remove global from stack
+
+instance StackValue (LuaFilterFunction a) where
+  valuetype _ = Lua.TFUNCTION
+  push lua v = pushFilterFunction lua v
+  peek lua i = do
+    isFn <- Lua.isfunction lua i
+    when (not isFn) (error $ "Not a function at index " ++ (show i))
+    Lua.pushvalue lua i
+    Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS"
+    len <- Lua.objlen lua (-1)
+    Lua.insert lua (-2)
+    Lua.rawseti lua (-2) (len + 1)
+    Lua.pop lua 1
+    return . Just $ LuaFilterFunction (len + 1)
+
+
+isLuaFunction :: Lua.LuaState -> String -> IO Bool
+isLuaFunction lua fnName = do
+  Lua.getglobal lua fnName
+  res <- Lua.isfunction lua (-1)
+  Lua.pop lua (-1)
+  return res
+
+maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
+maybeFromJson mv = fromJSON <$> mv >>= \case
+  Success x -> Just x
+  _         -> Nothing
+
+instance StackValue Pandoc where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
+
+instance StackValue Block where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
+
+instance StackValue Inline where
+  push lua = Lua.push lua . toJSON
+  peek lua i = maybeFromJson <$> peek lua i
+  valuetype _ = Lua.TTABLE
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs
new file mode 100644
index 000000000..5b2e82103
--- /dev/null
+++ b/src/Text/Pandoc/Lua/PandocModule.hs
@@ -0,0 +1,47 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+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.Lua.PandocModule
+   Copyright   : Copyright © 2017 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+Pandoc module for lua.
+-}
+module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where
+
+import Data.ByteString.Char8 ( unpack )
+import Scripting.Lua ( LuaState, loadstring, call)
+import Text.Pandoc.Shared ( readDataFile )
+
+
+-- | Push the "pandoc" on the lua stack.
+pushPandocModule :: LuaState -> IO ()
+pushPandocModule lua = do
+  script <- pandocModuleScript
+  status <- loadstring lua script "cn"
+  if (status /= 0)
+    then return ()
+    else do
+      call lua 0 1
+
+-- | Get the string representation of the pandoc module
+pandocModuleScript :: IO String
+pandocModuleScript = unpack <$> readDataFile Nothing "pandoc.lua"