summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Lua/SharedInstances.hs106
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs128
-rw-r--r--src/Text/Pandoc/Lua/Util.hs56
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs31
5 files changed, 166 insertions, 156 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 255a4ab65..f8cc78c64 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -457,6 +457,7 @@ Library
Text.Pandoc.Readers.Org.Shared,
Text.Pandoc.Lua.Compat,
Text.Pandoc.Lua.PandocModule,
+ Text.Pandoc.Lua.SharedInstances,
Text.Pandoc.Lua.StackInstances,
Text.Pandoc.Lua.Util,
Text.Pandoc.CSS,
diff --git a/src/Text/Pandoc/Lua/SharedInstances.hs b/src/Text/Pandoc/Lua/SharedInstances.hs
new file mode 100644
index 000000000..02438b93b
--- /dev/null
+++ b/src/Text/Pandoc/Lua/SharedInstances.hs
@@ -0,0 +1,106 @@
+{-
+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
+-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+#if !MIN_VERSION_base(4,8,0)
+{-# LANGUAGE OverlappingInstances #-}
+#endif
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+ Module : Text.Pandoc.Lua.SharedInstances
+ Copyright : © 2012–2016 John MacFarlane,
+ © 2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Shared StackValue instances for pandoc and generic types.
+-}
+module Text.Pandoc.Lua.SharedInstances () where
+
+import Scripting.Lua ( LTYPE(..), StackValue(..), newtable )
+import Text.Pandoc.Lua.Util ( addRawInt, addValue, getRawInt, keyValuePairs )
+
+import qualified Data.Map as M
+import qualified Text.Pandoc.UTF8 as UTF8
+
+#if MIN_VERSION_base(4,8,0)
+instance {-# OVERLAPS #-} StackValue [Char] where
+#else
+instance StackValue [Char] where
+#endif
+ push lua cs = push lua (UTF8.fromString cs)
+ peek lua i = fmap UTF8.toString <$> peek lua i
+ valuetype _ = TSTRING
+
+instance (StackValue a, StackValue b) => StackValue (a, b) where
+ push lua (a, b) = do
+ newtable lua
+ addRawInt lua 1 a
+ addRawInt lua 2 b
+ peek lua idx = do
+ a <- getRawInt lua idx 1
+ b <- getRawInt lua idx 2
+ return $ (,) <$> a <*> b
+ valuetype _ = TTABLE
+
+instance (StackValue a, StackValue b, StackValue c) =>
+ StackValue (a, b, c)
+ where
+ push lua (a, b, c) = do
+ newtable lua
+ addRawInt lua 1 a
+ addRawInt lua 2 b
+ addRawInt lua 3 c
+ peek lua idx = do
+ a <- getRawInt lua idx 1
+ b <- getRawInt lua idx 2
+ c <- getRawInt lua idx 3
+ return $ (,,) <$> a <*> b <*> c
+ valuetype _ = TTABLE
+
+instance (StackValue a, StackValue b, StackValue c,
+ StackValue d, StackValue e) =>
+ StackValue (a, b, c, d, e)
+ where
+ push lua (a, b, c, d, e) = do
+ newtable lua
+ 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 <- 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
+
+instance (Ord a, StackValue a, StackValue b) =>
+ StackValue (M.Map a b) where
+ push lua m = do
+ newtable lua
+ mapM_ (uncurry $ addValue lua) $ M.toList m
+ peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
+ valuetype _ = TTABLE
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index 8e26ece55..8af7f78c0 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -16,12 +16,8 @@ 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 CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
-#if !MIN_VERSION_base(4,8,0)
-{-# LANGUAGE OverlappingInstances #-}
-#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.StackInstances
@@ -38,15 +34,10 @@ module Text.Pandoc.Lua.StackInstances () where
import Control.Applicative ( (<|>) )
import Scripting.Lua
- ( LTYPE(..), LuaState, StackValue(..)
- , call, getglobal2, ltype, newtable, next, objlen, pop, pushnil
- )
+ ( LTYPE(..), LuaState, StackValue(..), getglobal2, ltype, newtable, objlen )
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
+import Text.Pandoc.Lua.SharedInstances ()
+import Text.Pandoc.Lua.Util ( addValue, getTable, pushViaConstructor )
instance StackValue Pandoc where
push lua (Pandoc meta blocks) = do
@@ -261,119 +252,6 @@ instance StackValue QuoteType where
_ -> return Nothing
valuetype _ = TTABLE
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} StackValue [Char] where
-#else
-instance StackValue [Char] where
-#endif
- push lua cs = push lua (UTF8.fromString cs)
- peek lua i = fmap UTF8.toString <$> peek lua i
- valuetype _ = TSTRING
-
-instance (StackValue a, StackValue b) => StackValue (a, b) where
- push lua (a, b) = do
- newtable lua
- addRawInt lua 1 a
- addRawInt lua 2 b
- peek lua idx = do
- a <- getRawInt lua idx 1
- b <- getRawInt lua idx 2
- return $ (,) <$> a <*> b
- valuetype _ = TTABLE
-
-instance (StackValue a, StackValue b, StackValue c) =>
- StackValue (a, b, c)
- where
- push lua (a, b, c) = do
- newtable lua
- addRawInt lua 1 a
- addRawInt lua 2 b
- addRawInt lua 3 c
- peek lua idx = do
- a <- getRawInt lua idx 1
- b <- getRawInt lua idx 2
- c <- getRawInt lua idx 3
- return $ (,,) <$> a <*> b <*> c
- valuetype _ = TTABLE
-
-instance (StackValue a, StackValue b, StackValue c,
- StackValue d, StackValue e) =>
- StackValue (a, b, c, d, e)
- where
- push lua (a, b, c, d, e) = do
- newtable lua
- 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 <- 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
-
-instance (Ord a, StackValue a, StackValue b) =>
- StackValue (M.Map a b) where
- push lua m = do
- newtable lua
- mapM_ (uncurry $ addValue lua) $ M.toList m
- peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
- valuetype _ = TTABLE
-
--- | Try reading the value under the given index as a list of key-value pairs.
-keyValuePairs :: (StackValue a, StackValue b)
- => LuaState -> Int -> IO (Maybe [(a, b)])
-keyValuePairs lua idx = do
- pushnil lua
- sequence <$> remainingPairs
- where
- remainingPairs = do
- res <- nextPair
- case res of
- Nothing -> return []
- Just a -> (a:) <$> remainingPairs
- nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
- nextPair = do
- hasNext <- next lua (idx `adjustIndexBy` 1)
- if hasNext
- then do
- val <- peek lua (-1)
- key <- peek lua (-2)
- pop lua 1 -- removes the value, keeps the key
- return $ Just <$> ((,) <$> key <*> val)
- else do
- return Nothing
-
-
--- | Helper class for pushing a single value to the stack via a lua function.
--- See @pushViaCall@.
-class PushViaCall a where
- pushViaCall' :: LuaState -> String -> IO () -> Int -> a
-
-instance PushViaCall (IO ()) where
- pushViaCall' lua fn pushArgs num = do
- getglobal2 lua fn
- pushArgs
- call lua num 1
-
-instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
- pushViaCall' lua fn pushArgs num x =
- pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
-
--- | Push an value to the stack via a lua function. The lua function is called
--- with all arguments that are passed to this function and is expected to return
--- a single value.
-pushViaCall :: PushViaCall a => LuaState -> String -> a
-pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
-
--- | Call a pandoc element constructor within lua, passing all given arguments.
-pushViaConstructor :: PushViaCall a => LuaState -> String -> a
-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
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 9c5625c3c..f0b87c231 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -16,6 +16,7 @@ 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 FlexibleInstances #-}
{- |
Module : Text.Pandoc.Lua.Util
Copyright : © 2012–2016 John MacFarlane,
@@ -35,11 +36,15 @@ module Text.Pandoc.Lua.Util
, getRawInt
, setRawInt
, addRawInt
+ , keyValuePairs
+ , PushViaCall
+ , pushViaCall
+ , pushViaConstructor
) where
import Scripting.Lua
( LuaState, StackValue(..)
- , gettable, pop, rawgeti, rawseti, settable
+ , call, getglobal2, gettable, next, pop, pushnil, rawgeti, rawseti, settable
)
-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
@@ -84,3 +89,52 @@ setRawInt lua idx key value = do
-- | Set numeric key/value in table at the top of the stack.
addRawInt :: StackValue a => LuaState -> Int -> a -> IO ()
addRawInt lua = setRawInt lua (-1)
+
+-- | Try reading the table under the given index as a list of key-value pairs.
+keyValuePairs :: (StackValue a, StackValue b)
+ => LuaState -> Int -> IO (Maybe [(a, b)])
+keyValuePairs lua idx = do
+ pushnil lua
+ sequence <$> remainingPairs
+ where
+ remainingPairs = do
+ res <- nextPair
+ case res of
+ Nothing -> return []
+ Just a -> (a:) <$> remainingPairs
+ nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))
+ nextPair = do
+ hasNext <- next lua (idx `adjustIndexBy` 1)
+ if hasNext
+ then do
+ val <- peek lua (-1)
+ key <- peek lua (-2)
+ pop lua 1 -- removes the value, keeps the key
+ return $ Just <$> ((,) <$> key <*> val)
+ else do
+ return Nothing
+
+-- | Helper class for pushing a single value to the stack via a lua function.
+-- See @pushViaCall@.
+class PushViaCall a where
+ pushViaCall' :: LuaState -> String -> IO () -> Int -> a
+
+instance PushViaCall (IO ()) where
+ pushViaCall' lua fn pushArgs num = do
+ getglobal2 lua fn
+ pushArgs
+ call lua num 1
+
+instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where
+ pushViaCall' lua fn pushArgs num x =
+ pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)
+
+-- | Push an value to the stack via a lua function. The lua function is called
+-- with all arguments that are passed to this function and is expected to return
+-- a single value.
+pushViaCall :: PushViaCall a => LuaState -> String -> a
+pushViaCall lua fn = pushViaCall' lua fn (return ()) 0
+
+-- | Call a pandoc element constructor within lua, passing all given arguments.
+pushViaConstructor :: PushViaCall a => LuaState -> String -> a
+pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index b06dd0c8a..ce90e4834 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -47,6 +47,7 @@ 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.Lua.SharedInstances ()
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Templates
@@ -59,41 +60,11 @@ attrToMap (id',classes,keyvals) = M.fromList
: ("class", unwords classes)
: keyvals
-#if MIN_VERSION_base(4,8,0)
-instance {-# OVERLAPS #-} StackValue [Char] where
-#else
-instance StackValue [Char] where
-#endif
- push lua cs = Lua.push lua (UTF8.fromString cs)
- peek lua i = do
- res <- Lua.peek lua i
- return $ UTF8.toString `fmap` res
- valuetype _ = Lua.TSTRING
-
instance StackValue Format where
push lua (Format f) = Lua.push lua (map toLower f)
peek l n = fmap Format `fmap` Lua.peek l n
valuetype _ = Lua.TSTRING
-instance (StackValue a, StackValue b) => StackValue (M.Map a b) where
- push lua m = do
- let xs = M.toList m
- Lua.createtable lua (length xs + 1) 0
- let addValue (k, v) = Lua.push lua k >> Lua.push lua v >>
- Lua.rawset lua (-3)
- mapM_ addValue xs
- peek _ _ = undefined -- not needed for our purposes
- valuetype _ = Lua.TTABLE
-
-instance (StackValue a, StackValue b) => StackValue (a,b) where
- push lua (k,v) = do
- Lua.createtable lua 2 0
- Lua.push lua k
- Lua.push lua v
- Lua.rawset lua (-3)
- peek _ _ = undefined -- not needed for our purposes
- valuetype _ = Lua.TTABLE
-
#if MIN_VERSION_base(4,8,0)
instance {-# OVERLAPS #-} StackValue [Inline] where
#else
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-14 12:57:54 +0000