From feb1c1a9301667cc3b6c36c5fda65c7014cfcdcf Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 14 Apr 2017 18:26:42 +0200 Subject: Extract lua helper functions into Lua.Util module --- pandoc.cabal | 1 + src/Text/Pandoc/Lua.hs | 20 +---- src/Text/Pandoc/Lua/StackInstances.hs | 159 ++++++++++++---------------------- src/Text/Pandoc/Lua/Util.hs | 86 ++++++++++++++++++ src/Text/Pandoc/Writers/Custom.hs | 17 ++-- 5 files changed, 152 insertions(+), 131 deletions(-) create mode 100644 src/Text/Pandoc/Lua/Util.hs diff --git a/pandoc.cabal b/pandoc.cabal index 27ccdb15b..255a4ab65 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -458,6 +458,7 @@ Library Text.Pandoc.Lua.Compat, Text.Pandoc.Lua.PandocModule, Text.Pandoc.Lua.StackInstances, + Text.Pandoc.Lua.Util, Text.Pandoc.CSS, Text.Pandoc.UUID, Text.Pandoc.Slides, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 9903d4df6..d8b9f62f0 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -18,7 +18,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua Copyright : Copyright © 2017 Albert Krewinkel @@ -49,7 +48,7 @@ runLuaFilter 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"::String) + Lua.push lua "PANDOC_FILTER_FUNCTIONS" Lua.newtable lua Lua.rawset lua Lua.registryindex -- store module in global "pandoc" @@ -65,7 +64,7 @@ runLuaFilter filterPath args pd = liftIO $ do Just luaFilters <- Lua.peek lua (-1) Lua.push lua args Lua.setglobal lua "PandocParameters" - doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd + doc <- runAll luaFilters pd Lua.close lua return doc @@ -73,13 +72,6 @@ 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) >=> @@ -227,11 +219,3 @@ instance StackValue (LuaFilterFunction a) where 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 diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs index 62beedabc..8e26ece55 100644 --- a/src/Text/Pandoc/Lua/StackInstances.hs +++ b/src/Text/Pandoc/Lua/StackInstances.hs @@ -25,7 +25,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {-# OPTIONS_GHC -fno-warn-orphans #-} {- | Module : Text.Pandoc.Lua.StackInstances - Copyright : Copyright © 2017 Albert Krewinkel + Copyright : © 2012-2016 John MacFarlane + © 2017 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel @@ -38,10 +39,11 @@ module Text.Pandoc.Lua.StackInstances () where import Control.Applicative ( (<|>) ) import Scripting.Lua ( LTYPE(..), LuaState, StackValue(..) - , call, getglobal2, gettable, ltype, newtable, next, objlen - , pop, pushnil, rawgeti, rawseti, settable + , call, getglobal2, ltype, newtable, next, objlen, pop, pushnil ) import Text.Pandoc.Definition +import Text.Pandoc.Lua.Util + ( adjustIndexBy, addValue, getTable, addRawInt, getRawInt ) import qualified Data.Map as M import qualified Text.Pandoc.UTF8 as UTF8 @@ -49,11 +51,11 @@ import qualified Text.Pandoc.UTF8 as UTF8 instance StackValue Pandoc where push lua (Pandoc meta blocks) = do newtable lua - addKeyValue lua "blocks" blocks - addKeyValue lua "meta" meta + addValue lua "blocks" blocks + addValue lua "meta" meta peek lua idx = do - blocks <- getField lua idx "blocks" - meta <- getField lua idx "meta" + blocks <- getTable lua idx "blocks" + meta <- getTable lua idx "meta" return $ Pandoc <$> meta <*> blocks valuetype _ = TTABLE @@ -71,22 +73,22 @@ instance StackValue MetaValue where MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap MetaString str -> push lua str peek lua idx = do + -- Get the contents of an AST element. + let elementContent :: StackValue a => IO (Maybe a) + elementContent = getTable lua idx "c" luatype <- ltype lua idx case luatype of TBOOLEAN -> fmap MetaBool <$> peek lua idx TSTRING -> fmap MetaString <$> peek lua idx TTABLE -> do - tag <- push lua "t" - *> gettable lua (idx `adjustIndexBy` 1) - *> peek lua (-1) - <* pop lua 1 + tag <- getTable lua idx "t" case tag of - Just "MetaBlocks" -> fmap MetaBlocks <$> peekContent lua idx - Just "MetaBool" -> fmap MetaBool <$> peekContent lua idx - Just "MetaMap" -> fmap MetaMap <$> peekContent lua idx - Just "MetaInlines" -> fmap MetaInlines <$> peekContent lua idx - Just "MetaList" -> fmap MetaList <$> peekContent lua idx - Just "MetaString" -> fmap MetaString <$> peekContent lua idx + Just "MetaBlocks" -> fmap MetaBlocks <$> elementContent + Just "MetaBool" -> fmap MetaBool <$> elementContent + Just "MetaMap" -> fmap MetaMap <$> elementContent + Just "MetaInlines" -> fmap MetaInlines <$> elementContent + Just "MetaList" -> fmap MetaList <$> elementContent + Just "MetaString" -> fmap MetaString <$> elementContent Nothing -> do len <- objlen lua idx if len <= 0 @@ -104,12 +106,6 @@ instance StackValue MetaValue where MetaMap _ -> TTABLE MetaString _ -> TSTRING -peekContent :: StackValue a => LuaState -> Int -> IO (Maybe a) -peekContent lua idx = do - push lua "c" - gettable lua (idx `adjustIndexBy` 1) - peek lua (-1) <* pop lua 1 - instance StackValue Block where push lua = \case BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks @@ -162,7 +158,7 @@ instance StackValue Alignment where AlignCenter -> getglobal2 lua "pandoc.AlignCenter" AlignDefault -> getglobal2 lua "pandoc.AlignDefault" peek lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Just "AlignLeft" -> return $ Just AlignLeft Just "AlignRight" -> return $ Just AlignRight @@ -175,12 +171,12 @@ instance StackValue Citation where push lua (Citation cid prefix suffix mode noteNum hash) = pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash peek lua idx = do - id' <- getField lua idx "citationId" - prefix <- getField lua idx "citationPrefix" - suffix <- getField lua idx "citationSuffix" - mode <- getField lua idx "citationMode" - num <- getField lua idx "citationNoteNum" - hash <- getField lua idx "citationHash" + id' <- getTable lua idx "citationId" + prefix <- getTable lua idx "citationPrefix" + suffix <- getTable lua idx "citationSuffix" + mode <- getTable lua idx "citationMode" + num <- getTable lua idx "citationNoteNum" + hash <- getTable lua idx "citationHash" return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash valuetype _ = TTABLE @@ -190,7 +186,7 @@ instance StackValue CitationMode where NormalCitation -> getglobal2 lua "pandoc.NormalCitation" SuppressAuthor -> getglobal2 lua "pandoc.SuppressAuthor" peek lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Just "AuthorInText" -> return $ Just AuthorInText Just "NormalCitation" -> return $ Just NormalCitation @@ -210,7 +206,7 @@ instance StackValue ListNumberDelim where OneParen -> getglobal2 lua "pandoc.OneParen" TwoParens -> getglobal2 lua "pandoc.TwoParens" peek lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Just "DefaultDelim" -> return $ Just DefaultDelim Just "Period" -> return $ Just Period @@ -229,7 +225,7 @@ instance StackValue ListNumberStyle where Decimal -> getglobal2 lua "pandoc.Decimal" Example -> getglobal2 lua "pandoc.Example" peek lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Just "DefaultStyle" -> return $ Just DefaultStyle Just "LowerRoman" -> return $ Just LowerRoman @@ -246,7 +242,7 @@ instance StackValue MathType where InlineMath -> getglobal2 lua "pandoc.InlineMath" DisplayMath -> getglobal2 lua "pandoc.DisplayMath" peek lua idx = do - res <- getField lua idx "t" + res <- getTable lua idx "t" case res of Just "InlineMath" -> return $ Just InlineMath Just "DisplayMath" -> return $ Just DisplayMath @@ -258,7 +254,7 @@ instance StackValue QuoteType where SingleQuote -> getglobal2 lua "pandoc.SingleQuote" DoubleQuote -> getglobal2 lua "pandoc.DoubleQuote" peek lua idx = do - res <- getField lua idx "t" + res <- getTable lua idx "t" case res of Just "SingleQuote" -> return $ Just SingleQuote Just "DoubleQuote" -> return $ Just DoubleQuote @@ -277,11 +273,11 @@ instance StackValue [Char] where instance (StackValue a, StackValue b) => StackValue (a, b) where push lua (a, b) = do newtable lua - addIndexedValue lua 1 a - addIndexedValue lua 2 b + addRawInt lua 1 a + addRawInt lua 2 b peek lua idx = do - a <- getIndexedValue lua idx 1 - b <- getIndexedValue lua idx 2 + a <- getRawInt lua idx 1 + b <- getRawInt lua idx 2 return $ (,) <$> a <*> b valuetype _ = TTABLE @@ -290,13 +286,13 @@ instance (StackValue a, StackValue b, StackValue c) => where push lua (a, b, c) = do newtable lua - addIndexedValue lua 1 a - addIndexedValue lua 2 b - addIndexedValue lua 3 c + addRawInt lua 1 a + addRawInt lua 2 b + addRawInt lua 3 c peek lua idx = do - a <- getIndexedValue lua idx 1 - b <- getIndexedValue lua idx 2 - c <- getIndexedValue lua idx 3 + a <- getRawInt lua idx 1 + b <- getRawInt lua idx 2 + c <- getRawInt lua idx 3 return $ (,,) <$> a <*> b <*> c valuetype _ = TTABLE @@ -306,17 +302,17 @@ instance (StackValue a, StackValue b, StackValue c, where push lua (a, b, c, d, e) = do newtable lua - addIndexedValue lua 1 a - addIndexedValue lua 2 b - addIndexedValue lua 3 c - addIndexedValue lua 4 d - addIndexedValue lua 5 e + addRawInt lua 1 a + addRawInt lua 2 b + addRawInt lua 3 c + addRawInt lua 4 d + addRawInt lua 5 e peek lua idx = do - a <- getIndexedValue lua idx 1 - b <- getIndexedValue lua idx 2 - c <- getIndexedValue lua idx 3 - d <- getIndexedValue lua idx 4 - e <- getIndexedValue lua idx 5 + a <- getRawInt lua idx 1 + b <- getRawInt lua idx 2 + c <- getRawInt lua idx 3 + d <- getRawInt lua idx 4 + e <- getRawInt lua idx 5 return $ (,,,,) <$> a <*> b <*> c <*> d <*> e valuetype _ = TTABLE @@ -324,7 +320,7 @@ instance (Ord a, StackValue a, StackValue b) => StackValue (M.Map a b) where push lua m = do newtable lua - mapM_ (uncurry $ addKeyValue lua) $ M.toList m + mapM_ (uncurry $ addValue lua) $ M.toList m peek lua idx = fmap M.fromList <$> keyValuePairs lua idx valuetype _ = TTABLE @@ -381,7 +377,7 @@ pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn) -- | Return the value at the given index as inline if possible. peekInline :: LuaState -> Int -> IO (Maybe Inline) peekInline lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Nothing -> return Nothing Just t -> case t of @@ -410,12 +406,12 @@ peekInline lua idx = do where -- Get the contents of an AST element. elementContent :: StackValue a => IO (Maybe a) - elementContent = getField lua idx "c" + elementContent = getTable lua idx "c" -- | Return the value at the given index as block if possible. peekBlock :: LuaState -> Int -> IO (Maybe Block) peekBlock lua idx = do - tag <- getField lua idx "t" + tag <- getTable lua idx "t" case tag of Nothing -> return Nothing Just t -> case t of @@ -440,47 +436,4 @@ peekBlock lua idx = do where -- Get the contents of an AST element. elementContent :: StackValue a => IO (Maybe a) - elementContent = getField lua idx "c" - --- | Adjust the stack index, assuming that @n@ new elements have been pushed on --- the stack. -adjustIndexBy :: Int -> Int -> Int -adjustIndexBy idx n = - if idx < 0 - then idx - n - else idx - --- | Get value behind key from table at given index. -getField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b) -getField lua idx key = do - push lua key - gettable lua (idx `adjustIndexBy` 1) - peek lua (-1) <* pop lua 1 - --- | Set value for key for table at the given index -setKeyValue :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO () -setKeyValue lua idx key value = do - push lua key - push lua value - settable lua (idx `adjustIndexBy` 2) - --- | Add a key-value pair to the table at the top of the stack -addKeyValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO () -addKeyValue lua = setKeyValue lua (-1) - --- | Get value behind key from table at given index. -getIndexedValue :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a) -getIndexedValue lua idx key = - rawgeti lua idx key - *> peek lua (-1) - <* pop lua 1 - --- | Set numeric key/value in table at the given index -setIndexedValue :: StackValue a => LuaState -> Int -> Int -> a -> IO () -setIndexedValue lua idx key value = do - push lua value - rawseti lua (idx `adjustIndexBy` 1) key - --- | Set numeric key/value in table at the top of the stack. -addIndexedValue :: StackValue a => LuaState -> Int -> a -> IO () -addIndexedValue lua = setIndexedValue lua (-1) + elementContent = getTable lua idx "c" diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs new file mode 100644 index 000000000..9c5625c3c --- /dev/null +++ b/src/Text/Pandoc/Lua/Util.hs @@ -0,0 +1,86 @@ +{- +Copyright © 2012-2016 John MacFarlane + 2017 Albert Krewinkel + +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.Util + Copyright : © 2012–2016 John MacFarlane, + © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Lua utility functions. +-} +module Text.Pandoc.Lua.Util + ( adjustIndexBy + , getTable + , setTable + , addValue + , getRawInt + , setRawInt + , addRawInt + ) where + +import Scripting.Lua + ( LuaState, StackValue(..) + , gettable, pop, rawgeti, rawseti, settable + ) + +-- | Adjust the stack index, assuming that @n@ new elements have been pushed on +-- the stack. +adjustIndexBy :: Int -> Int -> Int +adjustIndexBy idx n = + if idx < 0 + then idx - n + else idx + +-- | Get value behind key from table at given index. +getTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b) +getTable lua idx key = do + push lua key + gettable lua (idx `adjustIndexBy` 1) + peek lua (-1) <* pop lua 1 + +-- | Set value for key for table at the given index +setTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO () +setTable lua idx key value = do + push lua key + push lua value + settable lua (idx `adjustIndexBy` 2) + +-- | Add a key-value pair to the table at the top of the stack +addValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO () +addValue lua = setTable lua (-1) + +-- | Get value behind key from table at given index. +getRawInt :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a) +getRawInt lua idx key = + rawgeti lua idx key + *> peek lua (-1) + <* pop lua 1 + +-- | Set numeric key/value in table at the given index +setRawInt :: StackValue a => LuaState -> Int -> Int -> a -> IO () +setRawInt lua idx key value = do + push lua value + rawseti lua (idx `adjustIndexBy` 1) key + +-- | Set numeric key/value in table at the top of the stack. +addRawInt :: StackValue a => LuaState -> Int -> a -> IO () +addRawInt lua = setRawInt lua (-1) diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 58b222997..b06dd0c8a 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -2,8 +2,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} #if MIN_VERSION_base(4,8,0) #else {-# LANGUAGE OverlappingInstances #-} @@ -48,6 +46,7 @@ import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) import Scripting.Lua (LuaState, StackValue, callfunc) import qualified Scripting.Lua as Lua import Text.Pandoc.Lua.Compat ( loadstring ) +import Text.Pandoc.Lua.Util ( addValue ) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Templates @@ -131,14 +130,12 @@ instance StackValue MetaValue where instance StackValue Citation where push lua cit = do Lua.createtable lua 6 0 - let addValue (k :: String, v) = Lua.push lua k >> Lua.push lua v >> - Lua.rawset lua (-3) - addValue ("citationId", citationId cit) - addValue ("citationPrefix", citationPrefix cit) - addValue ("citationSuffix", citationSuffix cit) - addValue ("citationMode", show (citationMode cit)) - addValue ("citationNoteNum", citationNoteNum cit) - addValue ("citationHash", citationHash cit) + addValue lua "citationId" $ citationId cit + addValue lua "citationPrefix" $ citationPrefix cit + addValue lua "citationSuffix" $ citationSuffix cit + addValue lua "citationMode" $ show (citationMode cit) + addValue lua "citationNoteNum" $ citationNoteNum cit + addValue lua "citationHash" $ citationHash cit peek = undefined valuetype _ = Lua.TTABLE -- cgit v1.2.3