aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua.hs')
-rw-r--r--src/Text/Pandoc/Lua.hs233
1 files changed, 88 insertions, 145 deletions
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index f74c0e425..22b68d5e0 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -15,9 +20,6 @@ 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 FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{- |
Module : Text.Pandoc.Lua
Copyright : Copyright © 2017 Albert Krewinkel
@@ -28,11 +30,17 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Pandoc lua utils.
-}
-module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where
+module Text.Pandoc.Lua ( LuaException(..),
+ runLuaFilter,
+ pushPandocModule ) where
-import Control.Monad (unless, when, (>=>))
+import Control.Exception
+import Control.Monad (unless, when, (>=>), mplus)
import Control.Monad.Trans (MonadIO (..))
+import Data.Data (toConstr, showConstr, dataTypeOf, dataTypeConstrs, Data)
import Data.Map (Map)
+import Data.Maybe (isJust)
+import Data.Typeable (Typeable)
import Scripting.Lua (LuaState, StackValue (..))
import Text.Pandoc.Definition
import Text.Pandoc.Lua.PandocModule (pushPandocModule)
@@ -42,24 +50,25 @@ import Text.Pandoc.Walk
import qualified Data.Map as Map
import qualified Scripting.Lua as Lua
+newtype LuaException = LuaException String
+ deriving (Show, Typeable)
+
+instance Exception LuaException
+
runLuaFilter :: (MonadIO m)
- => FilePath -> [String] -> Pandoc -> m Pandoc
-runLuaFilter filterPath args pd = liftIO $ do
+ => Maybe FilePath -> FilePath -> [String] -> Pandoc -> m Pandoc
+runLuaFilter datadir filterPath args pd = liftIO $ do
lua <- Lua.newstate
Lua.openlibs lua
- -- create table in registry to store filter functions
- Lua.push lua "PANDOC_FILTER_FUNCTIONS"
- Lua.newtable lua
- Lua.rawset lua Lua.registryindex
-- store module in global "pandoc"
- pushPandocModule lua
+ pushPandocModule datadir lua
Lua.setglobal lua "pandoc"
top <- Lua.gettop lua
status <- Lua.loadfile lua filterPath
- if (status /= 0)
+ if status /= 0
then do
Just luaErrMsg <- Lua.peek lua 1
- error luaErrMsg
+ throwIO (LuaException luaErrMsg)
else do
Lua.call lua 0 Lua.multret
newtop <- Lua.gettop lua
@@ -80,157 +89,91 @@ pushGlobalFilter lua =
*> Lua.rawseti lua (-2) 1
runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
-runAll [] = return
-runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs
+runAll = foldr ((>=>) . walkMWithLuaFilter) return
walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
walkMWithLuaFilter (LuaFilter lua fnMap) =
- walkM (execInlineLuaFilter lua fnMap) >=>
- walkM (execBlockLuaFilter lua fnMap) >=>
- walkM (execMetaLuaFilter lua fnMap) >=>
- walkM (execDocLuaFilter lua fnMap)
+ (if hasOneOf (constructorsFor (dataTypeOf (Str [])))
+ then walkM (tryFilter lua fnMap :: Inline -> IO Inline)
+ else return)
+ >=>
+ (if hasOneOf (constructorsFor (dataTypeOf (Para [])))
+ then walkM (tryFilter lua fnMap :: Block -> IO Block)
+ else return)
+ >=>
+ (case Map.lookup "Meta" fnMap of
+ Just fn -> walkM (\(Pandoc meta blocks) -> do
+ meta' <- runFilterFunction lua fn meta
+ return $ Pandoc meta' blocks)
+ Nothing -> return)
+ >=>
+ (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of
+ Just fn -> (runFilterFunction lua fn) :: Pandoc -> IO Pandoc
+ Nothing -> return)
+ where hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
+ constructorsFor x = map show (dataTypeConstrs x)
type FunctionMap = Map String LuaFilterFunction
data LuaFilter = LuaFilter LuaState FunctionMap
newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
-execDocLuaFilter :: LuaState
- -> FunctionMap
- -> Pandoc -> IO Pandoc
-execDocLuaFilter lua fnMap x = do
- let docFnName = "Doc"
- case Map.lookup docFnName fnMap of
+tryFilter :: (Data a, StackValue a) => LuaState -> FunctionMap -> a -> IO a
+tryFilter lua fnMap x =
+ let filterFnName = showConstr (toConstr x) in
+ case Map.lookup filterFnName fnMap of
Nothing -> return x
- Just fn -> runLuaFilterFunction lua fn x
-
-execMetaLuaFilter :: LuaState
- -> FunctionMap
- -> Pandoc -> IO Pandoc
-execMetaLuaFilter lua fnMap pd@(Pandoc meta blks) = do
- let metaFnName = "Meta"
- case Map.lookup metaFnName fnMap of
- Nothing -> return pd
- Just fn -> do
- meta' <- runLuaFilterFunction lua fn meta
- return $ Pandoc meta' blks
-
-execBlockLuaFilter :: LuaState
- -> FunctionMap
- -> Block -> IO Block
-execBlockLuaFilter lua fnMap x = do
- let tryFilter :: String -> IO Block
- tryFilter filterFnName =
- case Map.lookup filterFnName fnMap of
- Nothing -> return x
- Just fn -> runLuaFilterFunction lua fn x
- case x of
- BlockQuote _ -> tryFilter "BlockQuote"
- BulletList _ -> tryFilter "BulletList"
- CodeBlock _ _ -> tryFilter "CodeBlock"
- DefinitionList _ -> tryFilter "DefinitionList"
- Div _ _ -> tryFilter "Div"
- Header _ _ _ -> tryFilter "Header"
- HorizontalRule -> tryFilter "HorizontalRule"
- LineBlock _ -> tryFilter "LineBlock"
- Null -> tryFilter "Null"
- Para _ -> tryFilter "Para"
- Plain _ -> tryFilter "Plain"
- RawBlock _ _ -> tryFilter "RawBlock"
- OrderedList _ _ -> tryFilter "OrderedList"
- Table _ _ _ _ _ -> tryFilter "Table"
-
-execInlineLuaFilter :: LuaState
- -> FunctionMap
- -> Inline -> IO Inline
-execInlineLuaFilter lua fnMap x = do
- let tryFilter :: String -> IO Inline
- tryFilter filterFnName =
- case Map.lookup filterFnName fnMap of
- Nothing -> return x
- Just fn -> runLuaFilterFunction lua fn x
- let tryFilterAlternatives :: [String] -> IO Inline
- tryFilterAlternatives [] = return x
- tryFilterAlternatives (fnName : alternatives) =
- case Map.lookup fnName fnMap of
- Nothing -> tryFilterAlternatives alternatives
- Just fn -> runLuaFilterFunction lua fn x
- case x of
- Cite _ _ -> tryFilter "Cite"
- Code _ _ -> tryFilter "Code"
- Emph _ -> tryFilter "Emph"
- Image _ _ _ -> tryFilter "Image"
- LineBreak -> tryFilter "LineBreak"
- Link _ _ _ -> tryFilter "Link"
- Math DisplayMath _ -> tryFilterAlternatives ["DisplayMath", "Math"]
- Math InlineMath _ -> tryFilterAlternatives ["InlineMath", "Math"]
- Note _ -> tryFilter "Note"
- Quoted DoubleQuote _ -> tryFilterAlternatives ["DoubleQuoted", "Quoted"]
- Quoted SingleQuote _ -> tryFilterAlternatives ["SingleQuoted", "Quoted"]
- RawInline _ _ -> tryFilter "RawInline"
- SmallCaps _ -> tryFilter "SmallCaps"
- SoftBreak -> tryFilter "SoftBreak"
- Space -> tryFilter "Space"
- Span _ _ -> tryFilter "Span"
- Str _ -> tryFilter "Str"
- Strikeout _ -> tryFilter "Strikeout"
- Strong _ -> tryFilter "Strong"
- Subscript _ -> tryFilter "Subscript"
- Superscript _ -> tryFilter "Superscript"
+ Just fn -> runFilterFunction lua fn x
instance StackValue LuaFilter where
valuetype _ = Lua.TTABLE
push = undefined
peek lua idx = fmap (LuaFilter lua) <$> Lua.peek lua idx
--- | Helper class for pushing a single value to the stack via a lua function.
--- See @pushViaCall@.
-class PushViaFilterFunction a where
- pushViaFilterFunction' :: LuaState -> LuaFilterFunction -> IO () -> Int -> a
-
-instance StackValue a => PushViaFilterFunction (IO a) where
- pushViaFilterFunction' lua lf pushArgs num = do
- pushFilterFunction lua lf
- pushArgs
- Lua.call lua num 1
- mbres <- Lua.peek lua (-1)
- case mbres of
- Nothing -> error $ "Error while trying to get a filter's return "
- ++ "value from lua stack."
- Just res -> res <$ Lua.pop lua 1
-
-instance (StackValue a, PushViaFilterFunction b) =>
- PushViaFilterFunction (a -> b) where
- pushViaFilterFunction' lua lf pushArgs num x =
- pushViaFilterFunction' lua lf (pushArgs *> push lua x) (num + 1)
-
--- | Push an value to the stack via a lua filter function. The function is
--- called with all arguments that are passed to this function and is expected to
--- return a single value.
-runLuaFilterFunction :: PushViaFilterFunction a
- => LuaState -> LuaFilterFunction -> a
-runLuaFilterFunction lua lf = pushViaFilterFunction' lua lf (return ()) 0
+-- | Push a value to the stack via a lua filter function. The filter function is
+-- called with given element as argument and is expected to return an element.
+-- Alternatively, the function can return nothing or nil, in which case the
+-- element is left unchanged.
+runFilterFunction :: StackValue a => LuaState -> LuaFilterFunction -> a -> IO a
+runFilterFunction lua lf x = do
+ pushFilterFunction lua lf
+ Lua.push lua x
+ z <- Lua.pcall lua 1 1 0
+ if (z /= 0)
+ then do
+ msg <- Lua.peek lua (-1)
+ let prefix = "Error while running filter function: "
+ throwIO . LuaException $
+ case msg of
+ Nothing -> prefix ++ "could not read error message"
+ Just msg' -> prefix ++ msg'
+ else do
+ resType <- Lua.ltype lua (-1)
+ case resType of
+ Lua.TNIL -> Lua.pop lua 1 *> return x
+ _ -> do
+ mbres <- Lua.peek lua (-1)
+ case mbres of
+ Nothing -> throwIO $ LuaException
+ ("Error while trying to get a filter's return "
+ ++ "value from lua stack.")
+ Just res -> res <$ Lua.pop lua 1
-- | Push the filter function to the top of the stack.
pushFilterFunction :: Lua.LuaState -> LuaFilterFunction -> IO ()
-pushFilterFunction lua lf = do
+pushFilterFunction lua lf =
-- The function is stored in a lua registry table, retrieve it from there.
- push lua ("PANDOC_FILTER_FUNCTIONS"::String)
- Lua.rawget lua Lua.registryindex
- Lua.rawgeti lua (-1) (functionIndex lf)
- Lua.remove lua (-2) -- remove registry table from stack
+ Lua.rawgeti lua Lua.registryindex (functionIndex lf)
+
+registerFilterFunction :: LuaState -> Int -> IO LuaFilterFunction
+registerFilterFunction lua idx = do
+ isFn <- Lua.isfunction lua idx
+ unless isFn . throwIO . LuaException $ "Not a function at index " ++ show idx
+ Lua.pushvalue lua idx
+ refIdx <- Lua.ref lua Lua.registryindex
+ return $ LuaFilterFunction refIdx
instance StackValue LuaFilterFunction where
valuetype _ = Lua.TFUNCTION
- push lua v = pushFilterFunction lua v
- peek lua i = do
- isFn <- Lua.isfunction lua i
- unless isFn (error $ "Not a function at index " ++ (show i))
- Lua.pushvalue lua i
- push lua ("PANDOC_FILTER_FUNCTIONS"::String)
- Lua.rawget lua Lua.registryindex
- len <- Lua.objlen lua (-1)
- Lua.insert lua (-2)
- Lua.rawseti lua (-2) (len + 1)
- Lua.pop lua 1
- return . Just $ LuaFilterFunction (len + 1)
+ push = pushFilterFunction
+ peek = fmap (fmap Just) . registerFilterFunction
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-19 03:32:33 +0000