Extract lua helper functions into Lua.Util module

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,

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

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 <tarleb+pandoc@moltkeplatz.de>
@@ -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
+  , call, getglobal2, ltype, newtable, next, objlen, pop, pushnil
-  , pop, pushnil, rawgeti, rawseti, settable
   )
 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
+    addValue lua "blocks" blocks
-    addKeyValue lua "meta"   meta
+    addValue lua "meta"   meta
   peek lua idx = do
-    blocks <- getField lua idx "blocks"
+    blocks <- getTable lua idx "blocks"
-    meta   <- getField lua idx "meta"
+    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"
+        tag <- getTable lua idx "t"
-               *> gettable lua (idx `adjustIndexBy` 1)
-               *> peek lua (-1)
-               <* pop lua 1
         case tag of
-          Just "MetaBlocks"  -> fmap MetaBlocks  <$> peekContent lua idx
+          Just "MetaBlocks"  -> fmap MetaBlocks  <$> elementContent
-          Just "MetaBool"    -> fmap MetaBool    <$> peekContent lua idx
+          Just "MetaBool"    -> fmap MetaBool    <$> elementContent
-          Just "MetaMap"     -> fmap MetaMap     <$> peekContent lua idx
+          Just "MetaMap"     -> fmap MetaMap     <$> elementContent
-          Just "MetaInlines" -> fmap MetaInlines <$> peekContent lua idx
+          Just "MetaInlines" -> fmap MetaInlines <$> elementContent
-          Just "MetaList"    -> fmap MetaList    <$> peekContent lua idx
+          Just "MetaList"    -> fmap MetaList    <$> elementContent
-          Just "MetaString"  -> fmap MetaString  <$> peekContent lua idx
+          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"
+    id' <- getTable lua idx "citationId"
-    prefix <- getField lua idx "citationPrefix"
+    prefix <- getTable lua idx "citationPrefix"
-    suffix <- getField lua idx "citationSuffix"
+    suffix <- getTable lua idx "citationSuffix"
-    mode <- getField lua idx "citationMode"
+    mode <- getTable lua idx "citationMode"
-    num <- getField lua idx "citationNoteNum"
+    num <- getTable lua idx "citationNoteNum"
-    hash <- getField lua idx "citationHash"
+    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
+    addRawInt lua 1 a
-    addIndexedValue lua 2 b
+    addRawInt lua 2 b
   peek lua idx = do
-    a <- getIndexedValue lua idx 1
+    a <- getRawInt lua idx 1
-    b <- getIndexedValue lua idx 2
+    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
+    addRawInt lua 1 a
-    addIndexedValue lua 2 b
+    addRawInt lua 2 b
-    addIndexedValue lua 3 c
+    addRawInt lua 3 c
   peek lua idx = do
-    a <- getIndexedValue lua idx 1
+    a <- getRawInt lua idx 1
-    b <- getIndexedValue lua idx 2
+    b <- getRawInt lua idx 2
-    c <- getIndexedValue lua idx 3
+    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
+    addRawInt lua 1 a
-    addIndexedValue lua 2 b
+    addRawInt lua 2 b
-    addIndexedValue lua 3 c
+    addRawInt lua 3 c
-    addIndexedValue lua 4 d
+    addRawInt lua 4 d
-    addIndexedValue lua 5 e
+    addRawInt lua 5 e
   peek lua idx = do
-    a <- getIndexedValue lua idx 1
+    a <- getRawInt lua idx 1
-    b <- getIndexedValue lua idx 2
+    b <- getRawInt lua idx 2
-    c <- getIndexedValue lua idx 3
+    c <- getRawInt lua idx 3
-    d <- getIndexedValue lua idx 4
+    d <- getRawInt lua idx 4
-    e <- getIndexedValue lua idx 5
+    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"
+   elementContent = getTable 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)

src/Text/Pandoc/Lua/Util.hs

@@ -0,0 +1,86 @@
+{-
+Copyright © 2012-2016 John MacFarlane <jgm@berkeley.edu>
+            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.Util
+   Copyright   : © 2012–2016 John MacFarlane,
+                 © 2017 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   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)

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 >>
+    addValue lua "citationId" $ citationId cit
-                          Lua.rawset lua (-3)
+    addValue lua "citationPrefix" $ citationPrefix cit
-    addValue ("citationId", citationId cit)
+    addValue lua "citationSuffix" $ citationSuffix cit
-    addValue ("citationPrefix", citationPrefix cit)
+    addValue lua "citationMode" $ show (citationMode cit)
-    addValue ("citationSuffix", citationSuffix cit)
+    addValue lua "citationNoteNum" $ citationNoteNum cit
-    addValue ("citationMode", show (citationMode cit))
+    addValue lua "citationHash" $ citationHash cit
-    addValue ("citationNoteNum", citationNoteNum cit)
-    addValue ("citationHash", citationHash cit)
   peek = undefined
   valuetype _ = Lua.TTABLE