summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2017-04-14 19:07:55 +0200
committerAlbert Krewinkel <albert@zeitkraut.de>2017-04-14 19:07:55 +0200
commit0add4253e6dc5c3cdca894c5bb312428fe3d31b3 (patch)
tree94c17edaa89af706104fcd5518e8de28720bd57a
parentfeb1c1a9301667cc3b6c36c5fda65c7014cfcdcf (diff)
Avoid repeating StackValue instances definitions
The lua filters and custom lua writer system defined very similar StackValue instances for strings and tuples. These instance definitions are extracted to a separate module to enable sharing.
-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