2dc3dbd · typeable/pandoc

git.iko.soy/typeable/pandoc

Use hslua >= 0.7, update Lua code

commit2dc3dbd68b557cbd8974b9daf84df3d26ab5f843 authorAlbert Krewinkel <albert@zeitkraut.de> dateSun 13 Aug 2017, 12:37 (9 years ago) parent418bda8

12 files changed+478−637

compare with master

unifiedsplit

pandoc.cabal+2−3 src/Text/Pandoc/Lua.hs+90−91 src/Text/Pandoc/Lua/Compat.hs−40 src/Text/Pandoc/Lua/PandocModule.hs+12−12 src/Text/Pandoc/Lua/SharedInstances.hs+5−77 src/Text/Pandoc/Lua/StackInstances.hs+204−203 src/Text/Pandoc/Lua/Util.hs+39−63 src/Text/Pandoc/Writers/Custom.hs+109−128 stack.full.yaml+1−1 stack.pkg.yaml+1−1 stack.yaml+1−1 test/Tests/Lua.hs+14−17

pandoc.cabal+2−3

@@ -317,7 +317,7 @@ Library

317317 yaml >= 0.8.8.2 && < 0.9,

318318 scientific >= 0.2 && < 0.4,

319319 vector >= 0.10 && < 0.13,

320− hslua >= 0.4 && < 0.6,

320+ hslua >= 0.7 && < 0.8,

321321 binary >= 0.5 && < 0.9,

322322 SHA >= 1.6 && < 1.7,

323323 haddock-library >= 1.1 && < 1.5,

@@ -464,7 +464,6 @@ Library

464464 Text.Pandoc.Readers.Org.ParserState,

465465 Text.Pandoc.Readers.Org.Parsing,

466466 Text.Pandoc.Readers.Org.Shared,

467− Text.Pandoc.Lua.Compat,

468467 Text.Pandoc.Lua.PandocModule,

469468 Text.Pandoc.Lua.SharedInstances,

470469 Text.Pandoc.Lua.StackInstances,

@@ -545,7 +544,7 @@ Test-Suite test-pandoc

545544 text >= 0.11 && < 1.3,

546545 directory >= 1 && < 1.4,

547546 filepath >= 1.1 && < 1.5,

548− hslua >= 0.4 && < 0.6,

547+ hslua >= 0.7 && < 0.8,

549548 process >= 1.2.3 && < 1.7,

550549 skylighting >= 0.3.3 && < 0.4,

551550 temporary >= 1.1 && < 1.3,

src/Text/Pandoc/Lua.hs+90−91

@@ -41,14 +41,16 @@ import Data.Data (toConstr, showConstr, dataTypeOf, dataTypeConstrs, Data)

4141import Data.Map (Map)

4242import Data.Maybe (isJust)

4343import Data.Typeable (Typeable)

44−import Scripting.Lua (LuaState, StackValue (..))

44+import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), runLua,

45+ peekEither, getglobal', throwLuaError)

46+import Foreign.Lua.Types.Lua (runLuaWith, liftLua1)

47+import Foreign.Lua.Api

4548import Text.Pandoc.Definition

4649import Text.Pandoc.Lua.PandocModule (pushPandocModule)

4750import Text.Pandoc.Lua.StackInstances ()

4851import Text.Pandoc.Walk

4952

5053import qualified Data.Map as Map

51−import qualified Scripting.Lua as Lua

5254

5355newtype LuaException = LuaException String

5456 deriving (Show, Typeable)

@@ -57,123 +59,120 @@ instance Exception LuaException

5759

5860runLuaFilter :: (MonadIO m)

5961 => Maybe FilePath -> FilePath -> [String] -> Pandoc -> m Pandoc

60−runLuaFilter datadir filterPath args pd = liftIO $ do

61− lua <- Lua.newstate

62− Lua.openlibs lua

62+runLuaFilter datadir filterPath args pd = liftIO . runLua $ do

63+ openlibs

6364 -- store module in global "pandoc"

64− pushPandocModule datadir lua

65− Lua.setglobal lua "pandoc"

66− top <- Lua.gettop lua

67− status <- Lua.loadfile lua filterPath

68− if status /= 0

65+ pushPandocModule datadir

66+ setglobal "pandoc"

67+ top <- gettop

68+ stat<- dofile filterPath

69+ if stat /= OK

6970 then do

70− Just luaErrMsg <- Lua.peek lua 1

71− throwIO (LuaException luaErrMsg)

71+ luaErrMsg <- peek (-1) <* pop 1

72+ throwLuaError luaErrMsg

7273 else do

73− Lua.call lua 0 Lua.multret

74− newtop <- Lua.gettop lua

74+ newtop <- gettop

7575 -- Use the implicitly defined global filter if nothing was returned

76− when (newtop - top < 1) $ pushGlobalFilter lua

77− Just luaFilters <- Lua.peek lua (-1)

78− Lua.push lua args

79− Lua.setglobal lua "PandocParameters"

80− doc <- runAll luaFilters pd

81− Lua.close lua

82− return doc

83−

84−pushGlobalFilter :: LuaState -> IO ()

85−pushGlobalFilter lua =

86− Lua.newtable lua

87− *> Lua.getglobal2 lua "pandoc.global_filter"

88− *> Lua.call lua 0 1

89− *> Lua.rawseti lua (-2) 1

90−

91−runAll :: [LuaFilter] -> Pandoc -> IO Pandoc

76+ when (newtop - top < 1) $ pushGlobalFilter

77+ luaFilters <- peek (-1)

78+ push args

79+ setglobal "PandocParameters"

80+ runAll luaFilters pd

81+

82+pushGlobalFilter :: Lua ()

83+pushGlobalFilter = do

84+ newtable

85+ getglobal' "pandoc.global_filter"

86+ call 0 1

87+ rawseti (-2) 1

88+

89+runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc

9290runAll = foldr ((>=>) . walkMWithLuaFilter) return

9391

94−walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc

95−walkMWithLuaFilter (LuaFilter lua fnMap) =

96− (if hasOneOf (constructorsFor (dataTypeOf (Str [])))

97− then walkM (tryFilter lua fnMap :: Inline -> IO Inline)

98− else return)

99− >=>

100− (if hasOneOf (constructorsFor (dataTypeOf (Para [])))

101− then walkM (tryFilter lua fnMap :: Block -> IO Block)

102− else return)

103− >=>

104− (case Map.lookup "Meta" fnMap of

105− Just fn -> walkM (\(Pandoc meta blocks) -> do

106− meta' <- runFilterFunction lua fn meta

107− return $ Pandoc meta' blocks)

108− Nothing -> return)

109− >=>

110− (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of

111− Just fn -> (runFilterFunction lua fn) :: Pandoc -> IO Pandoc

112− Nothing -> return)

113− where hasOneOf = any (\k -> isJust (Map.lookup k fnMap))

114− constructorsFor x = map show (dataTypeConstrs x)

92+walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc

93+walkMWithLuaFilter (LuaFilter fnMap) = liftLua1 walkLua

94+ where

95+ walkLua :: LuaState -> Pandoc -> IO Pandoc

96+ walkLua l =

97+ (if hasOneOf (constructorsFor (dataTypeOf (Str [])))

98+ then walkM (runLuaWith l . (tryFilter fnMap :: Inline -> Lua Inline))

99+ else return)

100+ >=>

101+ (if hasOneOf (constructorsFor (dataTypeOf (Para [])))

102+ then walkM ((runLuaWith l . (tryFilter fnMap :: Block -> Lua Block)))

103+ else return)

104+ >=>

105+ (case Map.lookup "Meta" fnMap of

106+ Just fn -> walkM ((\(Pandoc meta blocks) -> runLuaWith l $ do

107+ meta' <- runFilterFunction fn meta

108+ return $ Pandoc meta' blocks))

109+ Nothing -> return)

110+ >=>

111+ (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of

112+ Just fn -> runLuaWith l . (runFilterFunction fn :: Pandoc -> Lua Pandoc)

113+ Nothing -> return)

114+ hasOneOf = any (\k -> isJust (Map.lookup k fnMap))

115+ constructorsFor x = map show (dataTypeConstrs x)

115116

116117type FunctionMap = Map String LuaFilterFunction

117−data LuaFilter = LuaFilter LuaState FunctionMap

118+data LuaFilter = LuaFilter FunctionMap

118119

119120newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }

120121

121−tryFilter :: (Data a, StackValue a) => LuaState -> FunctionMap -> a -> IO a

122−tryFilter lua fnMap x =

122+-- | Try running a filter for the given element

123+tryFilter :: (Data a, FromLuaStack a, ToLuaStack a) => FunctionMap -> a -> Lua a

124+tryFilter fnMap x =

123125 let filterFnName = showConstr (toConstr x) in

124126 case Map.lookup filterFnName fnMap of

125127 Nothing -> return x

126− Just fn -> runFilterFunction lua fn x

128+ Just fn -> runFilterFunction fn x

127129

128−instance StackValue LuaFilter where

129− valuetype _ = Lua.TTABLE

130− push = undefined

131− peek lua idx = fmap (LuaFilter lua) <$> Lua.peek lua idx

130+instance FromLuaStack LuaFilter where

131+ peek idx = LuaFilter <$> peek idx

132132

133133-- | Push a value to the stack via a lua filter function. The filter function is

134134-- called with given element as argument and is expected to return an element.

135135-- Alternatively, the function can return nothing or nil, in which case the

136136-- element is left unchanged.

137−runFilterFunction :: StackValue a => LuaState -> LuaFilterFunction -> a -> IO a

138−runFilterFunction lua lf x = do

139− pushFilterFunction lua lf

140− Lua.push lua x

141− z <- Lua.pcall lua 1 1 0

142− if (z /= 0)

137+runFilterFunction :: (FromLuaStack a, ToLuaStack a)

138+ => LuaFilterFunction -> a -> Lua a

139+runFilterFunction lf x = do

140+ pushFilterFunction lf

141+ push x

142+ z <- pcall 1 1 Nothing

143+ if z /= OK

143144 then do

144− msg <- Lua.peek lua (-1)

145+ msg <- peek (-1)

145146 let prefix = "Error while running filter function: "

146− throwIO . LuaException $

147− case msg of

148− Nothing -> prefix ++ "could not read error message"

149− Just msg' -> prefix ++ msg'

147+ throwLuaError $ prefix ++ msg

150148 else do

151− resType <- Lua.ltype lua (-1)

149+ resType <- ltype (-1)

152150 case resType of

153− Lua.TNIL -> Lua.pop lua 1 *> return x

154− _ -> do

155− mbres <- Lua.peek lua (-1)

151+ TypeNil -> pop 1 *> return x

152+ _ -> do

153+ mbres <- peekEither (-1)

156154 case mbres of

157− Nothing -> throwIO $ LuaException

158− ("Error while trying to get a filter's return "

159− ++ "value from lua stack.")

160− Just res -> res <$ Lua.pop lua 1

155+ Left err -> throwLuaError

156+ ("Error while trying to get a filter's return "

157+ ++ "value from lua stack.\n" ++ err)

158+ Right res -> res <$ pop 1

161159

162160-- | Push the filter function to the top of the stack.

163−pushFilterFunction :: Lua.LuaState -> LuaFilterFunction -> IO ()

164−pushFilterFunction lua lf =

161+pushFilterFunction :: LuaFilterFunction -> Lua ()

162+pushFilterFunction lf =

165163 -- The function is stored in a lua registry table, retrieve it from there.

166− Lua.rawgeti lua Lua.registryindex (functionIndex lf)

167−

168−registerFilterFunction :: LuaState -> Int -> IO LuaFilterFunction

169−registerFilterFunction lua idx = do

170− isFn <- Lua.isfunction lua idx

171− unless isFn . throwIO . LuaException $ "Not a function at index " ++ show idx

172− Lua.pushvalue lua idx

173− refIdx <- Lua.ref lua Lua.registryindex

164+ rawgeti registryindex (functionIndex lf)

165+

166+registerFilterFunction :: StackIndex -> Lua LuaFilterFunction

167+registerFilterFunction idx = do

168+ isFn <- isfunction idx

169+ unless isFn . throwLuaError $ "Not a function at index " ++ show idx

170+ pushvalue idx

171+ refIdx <- ref registryindex

174172 return $ LuaFilterFunction refIdx

175173

176−instance StackValue LuaFilterFunction where

177− valuetype _ = Lua.TFUNCTION

174+instance ToLuaStack LuaFilterFunction where

178175 push = pushFilterFunction

179− peek = fmap (fmap Just) . registerFilterFunction

176+

177+instance FromLuaStack LuaFilterFunction where

178+ peek = registerFilterFunction

src/Text/Pandoc/Lua/Compat.hsdeleted−40

@@ -1,40 +0,0 @@

1−{-

3−

4−This program is free software; you can redistribute it and/or modify

5−it under the terms of the GNU General Public License as published by

6−the Free Software Foundation; either version 2 of the License, or

7−(at your option) any later version.

8−

9−This program is distributed in the hope that it will be useful,

10−but WITHOUT ANY WARRANTY; without even the implied warranty of

11−MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12−GNU General Public License for more details.

13−

14−You should have received a copy of the GNU General Public License

15−along with this program; if not, write to the Free Software

16−Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17−-}

18−{-# LANGUAGE CPP #-}

19−{- |

20− Module : Text.Pandoc.Lua.Compat

22− License : GNU GPL, version 2 or above

23−

24− Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

25− Stability : alpha

26−

27−Compatibility helpers for hslua

28−-}

29−module Text.Pandoc.Lua.Compat ( loadstring ) where

30−

31−import Scripting.Lua (LuaState)

32−import qualified Scripting.Lua as Lua

33−

34−-- | Interpret string as lua code and load into the lua environment.

35−loadstring :: LuaState -> String -> String -> IO Int

36−#if MIN_VERSION_hslua(0,5,0)

37−loadstring lua script _ = Lua.loadstring lua script

38−#else

39−loadstring lua script cn = Lua.loadstring lua script cn

40−#endif

src/Text/Pandoc/Lua/PandocModule.hs+12−12

@@ -31,31 +31,31 @@ import Control.Monad (unless)

3131import Data.ByteString.Char8 (unpack)

3232import Data.Default (Default (..))

3333import Data.Text (pack)

34−import Scripting.Lua (LuaState, call, push, pushhsfunction, rawset)

34+import Foreign.Lua (Lua, Status (OK), liftIO, push, pushHaskellFunction)

35+import Foreign.Lua.Api (call, loadstring, rawset)

3536import Text.Pandoc.Class

3637import Text.Pandoc.Definition (Pandoc)

3738import Text.Pandoc.Options (ReaderOptions(readerExtensions))

38−import Text.Pandoc.Lua.Compat (loadstring)

3939import Text.Pandoc.Lua.StackInstances ()

4040import Text.Pandoc.Readers (Reader (..), getReader)

4141

4242-- | Push the "pandoc" on the lua stack.

43−pushPandocModule :: Maybe FilePath -> LuaState -> IO ()

44−pushPandocModule datadir lua = do

45− script <- pandocModuleScript datadir

46− status <- loadstring lua script "pandoc.lua"

47− unless (status /= 0) $ call lua 0 1

48− push lua "__read"

49− pushhsfunction lua read_doc

50− rawset lua (-3)

43+pushPandocModule :: Maybe FilePath -> Lua ()

44+pushPandocModule datadir = do

45+ script <- liftIO (pandocModuleScript datadir)

46+ status <- loadstring script

47+ unless (status /= OK) $ call 0 1

48+ push "__read"

49+ pushHaskellFunction readDoc

50+ rawset (-3)

5151

5252-- | Get the string representation of the pandoc module

5353pandocModuleScript :: Maybe FilePath -> IO String

5454pandocModuleScript datadir = unpack <$>

5555 runIOorExplode (setUserDataDir datadir >> readDataFile "pandoc.lua")

5656

57−read_doc :: String -> String -> IO (Either String Pandoc)

58−read_doc formatSpec content = do

57+readDoc :: String -> String -> Lua (Either String Pandoc)

58+readDoc formatSpec content = liftIO $ do

5959 case getReader formatSpec of

6060 Left s -> return $ Left s

6161 Right (reader, es) ->

src/Text/Pandoc/Lua/SharedInstances.hs+5−77

@@ -36,81 +36,9 @@ Shared StackValue instances for pandoc and generic types.

3636-}

3737module Text.Pandoc.Lua.SharedInstances () where

3838

39−import Scripting.Lua (LTYPE (..), StackValue (..), newtable)

40−import Text.Pandoc.Lua.Util (addRawInt, addValue, getRawInt, keyValuePairs)

39+import Foreign.Lua (ToLuaStack (push))

4140

42−import qualified Data.Map as M

43−import qualified Text.Pandoc.UTF8 as UTF8

44−

45−#if MIN_VERSION_base(4,8,0)

46−instance {-# OVERLAPS #-} StackValue [Char] where

47−#else

48−instance StackValue [Char] where

49−#endif

50− push lua cs = push lua (UTF8.fromString cs)

51− peek lua i = fmap UTF8.toString <$> peek lua i

52− valuetype _ = TSTRING

53−

54−instance (StackValue a, StackValue b) => StackValue (a, b) where

55− push lua (a, b) = do

56− newtable lua

57− addRawInt lua 1 a

58− addRawInt lua 2 b

59− peek lua idx = do

60− a <- getRawInt lua idx 1

61− b <- getRawInt lua idx 2

62− return $ (,) <$> a <*> b

63− valuetype _ = TTABLE

64−

65−instance (StackValue a, StackValue b, StackValue c) =>

66− StackValue (a, b, c)

67− where

68− push lua (a, b, c) = do

69− newtable lua

70− addRawInt lua 1 a

71− addRawInt lua 2 b

72− addRawInt lua 3 c

73− peek lua idx = do

74− a <- getRawInt lua idx 1

75− b <- getRawInt lua idx 2

76− c <- getRawInt lua idx 3

77− return $ (,,) <$> a <*> b <*> c

78− valuetype _ = TTABLE

79−

80−instance (StackValue a, StackValue b, StackValue c,

81− StackValue d, StackValue e) =>

82− StackValue (a, b, c, d, e)

83− where

84− push lua (a, b, c, d, e) = do

85− newtable lua

86− addRawInt lua 1 a

87− addRawInt lua 2 b

88− addRawInt lua 3 c

89− addRawInt lua 4 d

90− addRawInt lua 5 e

91− peek lua idx = do

92− a <- getRawInt lua idx 1

93− b <- getRawInt lua idx 2

94− c <- getRawInt lua idx 3

95− d <- getRawInt lua idx 4

96− e <- getRawInt lua idx 5

97− return $ (,,,,) <$> a <*> b <*> c <*> d <*> e

98− valuetype _ = TTABLE

99−

100−instance (Ord a, StackValue a, StackValue b) =>

101− StackValue (M.Map a b) where

102− push lua m = do

103− newtable lua

104− mapM_ (uncurry $ addValue lua) $ M.toList m

105− peek lua idx = fmap M.fromList <$> keyValuePairs lua idx

106− valuetype _ = TTABLE

107−

108−instance (StackValue a, StackValue b) => StackValue (Either a b) where

109− push lua = \case

110− Left x -> push lua x

111− Right x -> push lua x

112− peek lua idx = peek lua idx >>= \case

113− Just left -> return . Just $ Left left

114− Nothing -> fmap Right <$> peek lua idx

115− valuetype (Left x) = valuetype x

116− valuetype (Right x) = valuetype x

41+instance (ToLuaStack a, ToLuaStack b) => ToLuaStack (Either a b) where

42+ push = \case

43+ Left x -> push x

44+ Right x -> push x

src/Text/Pandoc/Lua/StackInstances.hs+204−203

@@ -33,243 +33,244 @@ StackValue instances for pandoc types.

3333module Text.Pandoc.Lua.StackInstances () where

3434

3535import Control.Applicative ((<|>))

36−import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,

37− objlen)

36+import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),

37+ StackIndex, peekEither, throwLuaError)

38+import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)

3839import Text.Pandoc.Definition

3940import Text.Pandoc.Lua.SharedInstances ()

4041import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)

4142import Text.Pandoc.Shared (safeRead)

4243

43−instance StackValue Pandoc where

44− push lua (Pandoc meta blocks) = do

45− newtable lua

46− addValue lua "blocks" blocks

47− addValue lua "meta" meta

48− peek lua idx = do

49− blocks <- getTable lua idx "blocks"

50− meta <- getTable lua idx "meta"

51− return $ Pandoc <$> meta <*> blocks

52− valuetype _ = TTABLE

53−

54−instance StackValue Meta where

55− push lua (Meta mmap) = push lua mmap

56− peek lua idx = fmap Meta <$> peek lua idx

57− valuetype _ = TTABLE

58−

59−instance StackValue MetaValue where

44+instance ToLuaStack Pandoc where

45+ push (Pandoc meta blocks) = do

46+ newtable

47+ addValue "blocks" blocks

48+ addValue "meta" meta

49+instance FromLuaStack Pandoc where

50+ peek idx = do

51+ blocks <- getTable idx "blocks"

52+ meta <- getTable idx "meta"

53+ return $ Pandoc meta blocks

54+

55+instance ToLuaStack Meta where

56+ push (Meta mmap) = push mmap

57+instance FromLuaStack Meta where

58+ peek idx = Meta <$> peek idx

59+

60+instance ToLuaStack MetaValue where

6061 push = pushMetaValue

62+instance FromLuaStack MetaValue where

6163 peek = peekMetaValue

62− valuetype = \case

63− MetaBlocks _ -> TTABLE

64− MetaBool _ -> TBOOLEAN

65− MetaInlines _ -> TTABLE

66− MetaList _ -> TTABLE

67− MetaMap _ -> TTABLE

68− MetaString _ -> TSTRING

69−

70−instance StackValue Block where

64+

65+instance ToLuaStack Block where

7166 push = pushBlock

67+

68+instance FromLuaStack Block where

7269 peek = peekBlock

73− valuetype _ = TTABLE

7470

75−instance StackValue Inline where

71+-- Inline

72+instance ToLuaStack Inline where

7673 push = pushInline

74+

75+instance FromLuaStack Inline where

7776 peek = peekInline

78− valuetype _ = TTABLE

79−

80−instance StackValue Citation where

81− push lua (Citation cid prefix suffix mode noteNum hash) =

82− pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash

83− peek lua idx = do

84− id' <- getTable lua idx "citationId"

85− prefix <- getTable lua idx "citationPrefix"

86− suffix <- getTable lua idx "citationSuffix"

87− mode <- getTable lua idx "citationMode"

88− num <- getTable lua idx "citationNoteNum"

89− hash <- getTable lua idx "citationHash"

90− return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash

91− valuetype _ = TTABLE

92−

93−instance StackValue Alignment where

94− push lua = push lua . show

95− peek lua idx = (>>= safeRead) <$> peek lua idx

96− valuetype _ = TSTRING

97−

98−instance StackValue CitationMode where

99− push lua = push lua . show

100− peek lua idx = (>>= safeRead) <$> peek lua idx

101− valuetype _ = TSTRING

102−

103−instance StackValue Format where

104− push lua (Format f) = push lua f

105− peek lua idx = fmap Format <$> peek lua idx

106− valuetype _ = TSTRING

107−

108−instance StackValue ListNumberDelim where

109− push lua = push lua . show

110− peek lua idx = (>>= safeRead) <$> peek lua idx

111− valuetype _ = TSTRING

112−

113−instance StackValue ListNumberStyle where

114− push lua = push lua . show

115− peek lua idx = (>>= safeRead) <$> peek lua idx

116− valuetype _ = TSTRING

117−

118−instance StackValue MathType where

119− push lua = push lua . show

120− peek lua idx = (>>= safeRead) <$> peek lua idx

121− valuetype _ = TSTRING

122−

123−instance StackValue QuoteType where

124− push lua = push lua . show

125− peek lua idx = (>>= safeRead) <$> peek lua idx

126− valuetype _ = TSTRING

77+

78+-- Citation

79+instance ToLuaStack Citation where

80+ push (Citation cid prefix suffix mode noteNum hash) =

81+ pushViaConstructor "Citation" cid mode prefix suffix noteNum hash

82+

83+instance FromLuaStack Citation where

84+ peek idx = do

85+ id' <- getTable idx "citationId"

86+ prefix <- getTable idx "citationPrefix"

87+ suffix <- getTable idx "citationSuffix"

88+ mode <- getTable idx "citationMode"

89+ num <- getTable idx "citationNoteNum"

90+ hash <- getTable idx "citationHash"

91+ return $ Citation id' prefix suffix mode num hash

92+

93+instance ToLuaStack Alignment where

94+ push = push . show

95+instance FromLuaStack Alignment where

96+ peek idx = safeRead' =<< peek idx

97+

98+instance ToLuaStack CitationMode where

99+ push = push . show

100+instance FromLuaStack CitationMode where

101+ peek idx = safeRead' =<< peek idx

102+

103+instance ToLuaStack Format where

104+ push (Format f) = push f

105+instance FromLuaStack Format where

106+ peek idx = Format <$> peek idx

107+

108+instance ToLuaStack ListNumberDelim where

109+ push = push . show

110+instance FromLuaStack ListNumberDelim where

111+ peek idx = safeRead' =<< peek idx

112+

113+instance ToLuaStack ListNumberStyle where

114+ push = push . show

115+instance FromLuaStack ListNumberStyle where

116+ peek idx = safeRead' =<< peek idx

117+

118+instance ToLuaStack MathType where

119+ push = push . show

120+instance FromLuaStack MathType where

121+ peek idx = safeRead' =<< peek idx

122+

123+instance ToLuaStack QuoteType where

124+ push = push . show

125+instance FromLuaStack QuoteType where

126+ peek idx = safeRead' =<< peek idx

127+

128+safeRead' :: Read a => String -> Lua a

129+safeRead' s = case safeRead s of

130+ Nothing -> throwLuaError ("Could not read: " ++ s)

131+ Just x -> return x

127132

128133-- | Push an meta value element to the top of the lua stack.

129−pushMetaValue :: LuaState -> MetaValue -> IO ()

130−pushMetaValue lua = \case

131− MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks

132− MetaBool bool -> push lua bool

133− MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns

134− MetaList metalist -> pushViaConstructor lua "MetaList" metalist

135− MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap

136− MetaString str -> push lua str

134+pushMetaValue :: MetaValue -> Lua ()

135+pushMetaValue = \case

136+ MetaBlocks blcks -> pushViaConstructor "MetaBlocks" blcks

137+ MetaBool bool -> push bool

138+ MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns

139+ MetaList metalist -> pushViaConstructor "MetaList" metalist

140+ MetaMap metamap -> pushViaConstructor "MetaMap" metamap

141+ MetaString str -> push str

137142

138143-- | Interpret the value at the given stack index as meta value.

139−peekMetaValue :: LuaState -> Int -> IO (Maybe MetaValue)

140−peekMetaValue lua idx = do

144+peekMetaValue :: StackIndex -> Lua MetaValue

145+peekMetaValue idx = do

141146 -- Get the contents of an AST element.

142− let elementContent :: StackValue a => IO (Maybe a)

143− elementContent = peek lua idx

144− luatype <- ltype lua idx

147+ let elementContent :: FromLuaStack a => Lua a

148+ elementContent = peek idx

149+ luatype <- ltype idx

145150 case luatype of

146− TBOOLEAN -> fmap MetaBool <$> peek lua idx

147− TSTRING -> fmap MetaString <$> peek lua idx

148− TTABLE -> do

149− tag <- getTable lua idx "t"

151+ TypeBoolean -> MetaBool <$> peek idx

152+ TypeString -> MetaString <$> peek idx

153+ TypeTable -> do

154+ tag <- getfield idx "t" *> peekEither (-1) <* pop 1

150155 case tag of

151− Just "MetaBlocks" -> fmap MetaBlocks <$> elementContent

152− Just "MetaBool" -> fmap MetaBool <$> elementContent

153− Just "MetaMap" -> fmap MetaMap <$> elementContent

154− Just "MetaInlines" -> fmap MetaInlines <$> elementContent

155− Just "MetaList" -> fmap MetaList <$> elementContent

156− Just "MetaString" -> fmap MetaString <$> elementContent

157− Nothing -> do

156+ Right "MetaBlocks" -> MetaBlocks <$> elementContent

157+ Right "MetaBool" -> MetaBool <$> elementContent

158+ Right "MetaMap" -> MetaMap <$> elementContent

159+ Right "MetaInlines" -> MetaInlines <$> elementContent

160+ Right "MetaList" -> MetaList <$> elementContent

161+ Right "MetaString" -> MetaString <$> elementContent

162+ Right t -> throwLuaError ("Unknown meta tag: " ++ t)

163+ Left _ -> do

158164 -- no meta value tag given, try to guess.

159− len <- objlen lua idx

165+ len <- rawlen idx

160166 if len <= 0

161− then fmap MetaMap <$> peek lua idx

162− else (fmap MetaInlines <$> peek lua idx)

163− <|> (fmap MetaBlocks <$> peek lua idx)

164− <|> (fmap MetaList <$> peek lua idx)

165− _ -> return Nothing

166− _ -> return Nothing

167+ then MetaMap <$> peek idx

168+ else (MetaInlines <$> peek idx)

169+ <|> (MetaBlocks <$> peek idx)

170+ <|> (MetaList <$> peek idx)

171+ _ -> throwLuaError ("could not get meta value")

167172

168173-- | Push an block element to the top of the lua stack.

169−pushBlock :: LuaState -> Block -> IO ()

170−pushBlock lua = \case

171− BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks

172− BulletList items -> pushViaConstructor lua "BulletList" items

173− CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code (LuaAttr attr)

174− DefinitionList items -> pushViaConstructor lua "DefinitionList" items

175− Div attr blcks -> pushViaConstructor lua "Div" blcks (LuaAttr attr)

176− Header lvl attr inlns -> pushViaConstructor lua "Header" lvl inlns (LuaAttr attr)

177− HorizontalRule -> pushViaConstructor lua "HorizontalRule"

178− LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks

179− OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr

180− Null -> pushViaConstructor lua "Null"

181− Para blcks -> pushViaConstructor lua "Para" blcks

182− Plain blcks -> pushViaConstructor lua "Plain" blcks

183− RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs

174+pushBlock :: Block -> Lua ()

175+pushBlock = \case

176+ BlockQuote blcks -> pushViaConstructor "BlockQuote" blcks

177+ BulletList items -> pushViaConstructor "BulletList" items

178+ CodeBlock attr code -> pushViaConstructor "CodeBlock" code (LuaAttr attr)

179+ DefinitionList items -> pushViaConstructor "DefinitionList" items

180+ Div attr blcks -> pushViaConstructor "Div" blcks (LuaAttr attr)

181+ Header lvl attr inlns -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)

182+ HorizontalRule -> pushViaConstructor "HorizontalRule"

183+ LineBlock blcks -> pushViaConstructor "LineBlock" blcks

184+ OrderedList lstAttr list -> pushViaConstructor "OrderedList" list lstAttr

185+ Null -> pushViaConstructor "Null"

186+ Para blcks -> pushViaConstructor "Para" blcks

187+ Plain blcks -> pushViaConstructor "Plain" blcks

188+ RawBlock f cs -> pushViaConstructor "RawBlock" f cs

184189 Table capt aligns widths headers rows ->

185− pushViaConstructor lua "Table" capt aligns widths headers rows

190+ pushViaConstructor "Table" capt aligns widths headers rows

186191

187192-- | Return the value at the given index as block if possible.

188−peekBlock :: LuaState -> Int -> IO (Maybe Block)

189−peekBlock lua idx = do

190− tag <- getTable lua idx "t"

193+peekBlock :: StackIndex -> Lua Block

194+peekBlock idx = do

195+ tag <- getTable idx "t"

191196 case tag of

192− Nothing -> return Nothing

193− Just t -> case t of

194− "BlockQuote" -> fmap BlockQuote <$> elementContent

195− "BulletList" -> fmap BulletList <$> elementContent

196− "CodeBlock" -> fmap (withAttr CodeBlock) <$> elementContent

197− "DefinitionList" -> fmap DefinitionList <$> elementContent

198− "Div" -> fmap (withAttr Div) <$> elementContent

199− "Header" -> fmap (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)

197+ "BlockQuote" -> BlockQuote <$> elementContent

198+ "BulletList" -> BulletList <$> elementContent

199+ "CodeBlock" -> (withAttr CodeBlock) <$> elementContent

200+ "DefinitionList" -> DefinitionList <$> elementContent

201+ "Div" -> (withAttr Div) <$> elementContent

202+ "Header" -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)

200203 <$> elementContent

201− "HorizontalRule" -> return (Just HorizontalRule)

202− "LineBlock" -> fmap LineBlock <$> elementContent

203− "OrderedList" -> fmap (uncurry OrderedList) <$> elementContent

204− "Null" -> return (Just Null)

205− "Para" -> fmap Para <$> elementContent

206− "Plain" -> fmap Plain <$> elementContent

207− "RawBlock" -> fmap (uncurry RawBlock) <$> elementContent

208− "Table" -> fmap (\(capt, aligns, widths, headers, body) ->

204+ "HorizontalRule" -> return HorizontalRule

205+ "LineBlock" -> LineBlock <$> elementContent

206+ "OrderedList" -> (uncurry OrderedList) <$> elementContent

207+ "Null" -> return Null

208+ "Para" -> Para <$> elementContent

209+ "Plain" -> Plain <$> elementContent

210+ "RawBlock" -> (uncurry RawBlock) <$> elementContent

211+ "Table" -> (\(capt, aligns, widths, headers, body) ->

209212 Table capt aligns widths headers body)

210213 <$> elementContent

211− _ -> return Nothing

214+ _ -> throwLuaError ("Unknown block type: " ++ tag)

212215 where

213216 -- Get the contents of an AST element.

214− elementContent :: StackValue a => IO (Maybe a)

215− elementContent = getTable lua idx "c"

217+ elementContent :: FromLuaStack a => Lua a

218+ elementContent = getTable idx "c"

216219

217220-- | Push an inline element to the top of the lua stack.

218−pushInline :: LuaState -> Inline -> IO ()

219−pushInline lua = \case

220− Cite citations lst -> pushViaConstructor lua "Cite" lst citations

221− Code attr lst -> pushViaConstructor lua "Code" lst (LuaAttr attr)

222− Emph inlns -> pushViaConstructor lua "Emph" inlns

223− Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit (LuaAttr attr)

224− LineBreak -> pushViaConstructor lua "LineBreak"

225− Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit (LuaAttr attr)

226− Note blcks -> pushViaConstructor lua "Note" blcks

227− Math mty str -> pushViaConstructor lua "Math" mty str

228− Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns

229− RawInline f cs -> pushViaConstructor lua "RawInline" f cs

230− SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns

231− SoftBreak -> pushViaConstructor lua "SoftBreak"

232− Space -> pushViaConstructor lua "Space"

233− Span attr inlns -> pushViaConstructor lua "Span" inlns (LuaAttr attr)

234− Str str -> pushViaConstructor lua "Str" str

235− Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns

236− Strong inlns -> pushViaConstructor lua "Strong" inlns

237− Subscript inlns -> pushViaConstructor lua "Subscript" inlns

238− Superscript inlns -> pushViaConstructor lua "Superscript" inlns

221+pushInline :: Inline -> Lua ()

222+pushInline = \case

223+ Cite citations lst -> pushViaConstructor "Cite" lst citations

224+ Code attr lst -> pushViaConstructor "Code" lst (LuaAttr attr)

225+ Emph inlns -> pushViaConstructor "Emph" inlns

226+ Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)

227+ LineBreak -> pushViaConstructor "LineBreak"

228+ Link attr lst (src,tit) -> pushViaConstructor "Link" lst src tit (LuaAttr attr)

229+ Note blcks -> pushViaConstructor "Note" blcks

230+ Math mty str -> pushViaConstructor "Math" mty str

231+ Quoted qt inlns -> pushViaConstructor "Quoted" qt inlns

232+ RawInline f cs -> pushViaConstructor "RawInline" f cs

233+ SmallCaps inlns -> pushViaConstructor "SmallCaps" inlns

234+ SoftBreak -> pushViaConstructor "SoftBreak"

235+ Space -> pushViaConstructor "Space"

236+ Span attr inlns -> pushViaConstructor "Span" inlns (LuaAttr attr)

237+ Str str -> pushViaConstructor "Str" str

238+ Strikeout inlns -> pushViaConstructor "Strikeout" inlns

239+ Strong inlns -> pushViaConstructor "Strong" inlns

240+ Subscript inlns -> pushViaConstructor "Subscript" inlns

241+ Superscript inlns -> pushViaConstructor "Superscript" inlns

239242

240243-- | Return the value at the given index as inline if possible.

241−peekInline :: LuaState -> Int -> IO (Maybe Inline)

242−peekInline lua idx = do

243− tag <- getTable lua idx "t"

244+peekInline :: StackIndex -> Lua Inline

245+peekInline idx = do

246+ tag <- getTable idx "t"

244247 case tag of

245− Nothing -> return Nothing

246− Just t -> case t of

247− "Cite" -> fmap (uncurry Cite) <$> elementContent

248− "Code" -> fmap (withAttr Code) <$> elementContent

249− "Emph" -> fmap Emph <$> elementContent

250− "Image" -> fmap (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)

251− <$> elementContent

252− "Link" -> fmap (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)

253− <$> elementContent

254− "LineBreak" -> return (Just LineBreak)

255− "Note" -> fmap Note <$> elementContent

256− "Math" -> fmap (uncurry Math) <$> elementContent

257− "Quoted" -> fmap (uncurry Quoted) <$> elementContent

258− "RawInline" -> fmap (uncurry RawInline) <$> elementContent

259− "SmallCaps" -> fmap SmallCaps <$> elementContent

260− "SoftBreak" -> return (Just SoftBreak)

261− "Space" -> return (Just Space)

262− "Span" -> fmap (withAttr Span) <$> elementContent

263− "Str" -> fmap Str <$> elementContent

264− "Strikeout" -> fmap Strikeout <$> elementContent

265− "Strong" -> fmap Strong <$> elementContent

266− "Subscript" -> fmap Subscript <$> elementContent

267− "Superscript"-> fmap Superscript <$> elementContent

268− _ -> return Nothing

248+ "Cite" -> (uncurry Cite) <$> elementContent

249+ "Code" -> (withAttr Code) <$> elementContent

250+ "Emph" -> Emph <$> elementContent

251+ "Image" -> (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)

252+ <$> elementContent

253+ "Link" -> (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)

254+ <$> elementContent

255+ "LineBreak" -> return LineBreak

256+ "Note" -> Note <$> elementContent

257+ "Math" -> (uncurry Math) <$> elementContent

258+ "Quoted" -> (uncurry Quoted) <$> elementContent

259+ "RawInline" -> (uncurry RawInline) <$> elementContent

260+ "SmallCaps" -> SmallCaps <$> elementContent

261+ "SoftBreak" -> return SoftBreak

262+ "Space" -> return Space

263+ "Span" -> (withAttr Span) <$> elementContent

264+ "Str" -> Str <$> elementContent

265+ "Strikeout" -> Strikeout <$> elementContent

266+ "Strong" -> Strong <$> elementContent

267+ "Subscript" -> Subscript <$> elementContent

268+ "Superscript"-> Superscript <$> elementContent

269+ _ -> throwLuaError ("Unknown inline type: " ++ tag)

269270 where

270271 -- Get the contents of an AST element.

271− elementContent :: StackValue a => IO (Maybe a)

272− elementContent = getTable lua idx "c"

272+ elementContent :: FromLuaStack a => Lua a

273+ elementContent = getTable idx "c"

273274

274275withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b

275276withAttr f (attributes, x) = f (fromLuaAttr attributes) x

@@ -277,8 +278,8 @@ withAttr f (attributes, x) = f (fromLuaAttr attributes) x

277278-- | Wrapper for Attr

278279newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }

279280

280−instance StackValue LuaAttr where

281− push lua (LuaAttr (id', classes, kv)) =

282− pushViaConstructor lua "Attr" id' classes kv

283− peek lua idx = fmap LuaAttr <$> peek lua idx

284− valuetype _ = TTABLE

281+instance ToLuaStack LuaAttr where

282+ push (LuaAttr (id', classes, kv)) =

283+ pushViaConstructor "Attr" id' classes kv

284+instance FromLuaStack LuaAttr where

285+ peek idx = LuaAttr <$> peek idx

src/Text/Pandoc/Lua/Util.hs+39−63

@@ -36,103 +36,79 @@ module Text.Pandoc.Lua.Util

3636 , getRawInt

3737 , setRawInt

3838 , addRawInt

39− , keyValuePairs

4039 , PushViaCall

4140 , pushViaCall

4241 , pushViaConstructor

4342 ) where

4443

45−import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,

46− next, pop, pushnil, rawgeti, rawseti, settable)

44+import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), NumArgs,

45+ StackIndex, getglobal')

46+import Foreign.Lua.Api (call, gettable, pop, rawgeti, rawseti, settable)

4747

4848-- | Adjust the stack index, assuming that @n@ new elements have been pushed on

4949-- the stack.

50−adjustIndexBy :: Int -> Int -> Int

50+adjustIndexBy :: StackIndex -> StackIndex -> StackIndex

5151adjustIndexBy idx n =

5252 if idx < 0

5353 then idx - n

5454 else idx

5555

5656-- | Get value behind key from table at given index.

57−getTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)

58−getTable lua idx key = do

59− push lua key

60− gettable lua (idx `adjustIndexBy` 1)

61− peek lua (-1) <* pop lua 1

57+getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b

58+getTable idx key = do

59+ push key

60+ gettable (idx `adjustIndexBy` 1)

61+ peek (-1) <* pop 1

6262

6363-- | Set value for key for table at the given index

64−setTable :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()

65−setTable lua idx key value = do

66− push lua key

67− push lua value

68− settable lua (idx `adjustIndexBy` 2)

64+setTable :: (ToLuaStack a, ToLuaStack b) => StackIndex -> a -> b -> Lua ()

65+setTable idx key value = do

66+ push key

67+ push value

68+ settable (idx `adjustIndexBy` 2)

6969

7070-- | Add a key-value pair to the table at the top of the stack

71−addValue :: (StackValue a, StackValue b) => LuaState -> a -> b -> IO ()

72−addValue lua = setTable lua (-1)

71+addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()

72+addValue = setTable (-1)

7373

7474-- | Get value behind key from table at given index.

75−getRawInt :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)

76−getRawInt lua idx key =

77− rawgeti lua idx key

78− *> peek lua (-1)

79− <* pop lua 1

75+getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a

76+getRawInt idx key =

77+ rawgeti idx key

78+ *> peek (-1)

79+ <* pop 1

8080

8181-- | Set numeric key/value in table at the given index

82−setRawInt :: StackValue a => LuaState -> Int -> Int -> a -> IO ()

83−setRawInt lua idx key value = do

84− push lua value

85− rawseti lua (idx `adjustIndexBy` 1) key

82+setRawInt :: ToLuaStack a => StackIndex -> Int -> a -> Lua ()

83+setRawInt idx key value = do

84+ push value

85+ rawseti (idx `adjustIndexBy` 1) key

8686

8787-- | Set numeric key/value in table at the top of the stack.

88−addRawInt :: StackValue a => LuaState -> Int -> a -> IO ()

89−addRawInt lua = setRawInt lua (-1)

90−

91−-- | Try reading the table under the given index as a list of key-value pairs.

92−keyValuePairs :: (StackValue a, StackValue b)

93− => LuaState -> Int -> IO (Maybe [(a, b)])

94−keyValuePairs lua idx = do

95− pushnil lua

96− sequence <$> remainingPairs

97− where

98− remainingPairs = do

99− res <- nextPair

100− case res of

101− Nothing -> return []

102− Just a -> (a:) <$> remainingPairs

103− nextPair :: (StackValue a, StackValue b) => IO (Maybe (Maybe (a,b)))

104− nextPair = do

105− hasNext <- next lua (idx `adjustIndexBy` 1)

106− if hasNext

107− then do

108− val <- peek lua (-1)

109− key <- peek lua (-2)

110− pop lua 1 -- removes the value, keeps the key

111− return $ Just <$> ((,) <$> key <*> val)

112− else do

113− return Nothing

88+addRawInt :: ToLuaStack a => Int -> a -> Lua ()

89+addRawInt = setRawInt (-1)

11490

11591-- | Helper class for pushing a single value to the stack via a lua function.

11692-- See @pushViaCall@.

11793class PushViaCall a where

118− pushViaCall' :: LuaState -> String -> IO () -> Int -> a

94+ pushViaCall' :: String -> Lua () -> NumArgs -> a

11995

120−instance PushViaCall (IO ()) where

121− pushViaCall' lua fn pushArgs num = do

122− getglobal2 lua fn

96+instance PushViaCall (Lua ()) where

97+ pushViaCall' fn pushArgs num = do

98+ getglobal' fn

12399 pushArgs

124− call lua num 1

100+ call num 1

125101

126−instance (StackValue a, PushViaCall b) => PushViaCall (a -> b) where

127− pushViaCall' lua fn pushArgs num x =

128− pushViaCall' lua fn (pushArgs *> push lua x) (num + 1)

102+instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where

103+ pushViaCall' fn pushArgs num x =

104+ pushViaCall' fn (pushArgs *> push x) (num + 1)

129105

130106-- | Push an value to the stack via a lua function. The lua function is called

131107-- with all arguments that are passed to this function and is expected to return

132108-- a single value.

133−pushViaCall :: PushViaCall a => LuaState -> String -> a

134−pushViaCall lua fn = pushViaCall' lua fn (return ()) 0

109+pushViaCall :: PushViaCall a => String -> a

110+pushViaCall fn = pushViaCall' fn (return ()) 0

135111

136112-- | Call a pandoc element constructor within lua, passing all given arguments.

137−pushViaConstructor :: PushViaCall a => LuaState -> String -> a

138−pushViaConstructor lua pandocFn = pushViaCall lua ("pandoc." ++ pandocFn)

113+pushViaConstructor :: PushViaCall a => String -> a

114+pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)

src/Text/Pandoc/Writers/Custom.hs+109−128

@@ -44,10 +44,9 @@ import qualified Data.Map as M

4444import Data.Text (Text, pack)

4545import Data.Typeable

4646import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)

47−import Scripting.Lua (LuaState, StackValue, callfunc)

48−import qualified Scripting.Lua as Lua

47+import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua)

48+import Foreign.Lua.Api

4949import Text.Pandoc.Error

50−import Text.Pandoc.Lua.Compat ( loadstring )

5150import Text.Pandoc.Lua.Util ( addValue )

5251import Text.Pandoc.Lua.SharedInstances ()

5352import Text.Pandoc.Definition

@@ -62,55 +61,40 @@ attrToMap (id',classes,keyvals) = M.fromList

6261 : ("class", unwords classes)

6362 : keyvals

6463

65−instance StackValue Format where

66− push lua (Format f) = Lua.push lua (map toLower f)

67− peek l n = fmap Format `fmap` Lua.peek l n

68− valuetype _ = Lua.TSTRING

64+instance ToLuaStack Format where

65+ push (Format f) = push (map toLower f)

6966

7067#if MIN_VERSION_base(4,8,0)

71−instance {-# OVERLAPS #-} StackValue [Inline] where

68+instance {-# OVERLAPS #-} ToLuaStack [Inline] where

7269#else

73−instance StackValue [Inline] where

70+instance ToLuaStack [Inline] where

7471#endif

75− push l ils = Lua.push l =<< inlineListToCustom l ils

76− peek _ _ = undefined

77− valuetype _ = Lua.TSTRING

72+ push ils = push =<< inlineListToCustom ils

7873

7974#if MIN_VERSION_base(4,8,0)

80−instance {-# OVERLAPS #-} StackValue [Block] where

75+instance {-# OVERLAPS #-} ToLuaStack [Block] where

8176#else

82−instance StackValue [Block] where

77+instance ToLuaStack [Block] where

8378#endif

84− push l ils = Lua.push l =<< blockListToCustom l ils

85− peek _ _ = undefined

86− valuetype _ = Lua.TSTRING

87−

88−instance StackValue MetaValue where

89− push l (MetaMap m) = Lua.push l m

90− push l (MetaList xs) = Lua.push l xs

91− push l (MetaBool x) = Lua.push l x

92− push l (MetaString s) = Lua.push l s

93− push l (MetaInlines ils) = Lua.push l ils

94− push l (MetaBlocks bs) = Lua.push l bs

95− peek _ _ = undefined

96− valuetype (MetaMap _) = Lua.TTABLE

97− valuetype (MetaList _) = Lua.TTABLE

98− valuetype (MetaBool _) = Lua.TBOOLEAN

99− valuetype (MetaString _) = Lua.TSTRING

100− valuetype (MetaInlines _) = Lua.TSTRING

101− valuetype (MetaBlocks _) = Lua.TSTRING

102−

103−instance StackValue Citation where

104− push lua cit = do

105− Lua.createtable lua 6 0

106− addValue lua "citationId" $ citationId cit

107− addValue lua "citationPrefix" $ citationPrefix cit

108− addValue lua "citationSuffix" $ citationSuffix cit

109− addValue lua "citationMode" $ show (citationMode cit)

110− addValue lua "citationNoteNum" $ citationNoteNum cit

111− addValue lua "citationHash" $ citationHash cit

112− peek = undefined

113− valuetype _ = Lua.TTABLE

79+ push ils = push =<< blockListToCustom ils

80+

81+instance ToLuaStack MetaValue where

82+ push (MetaMap m) = push m

83+ push (MetaList xs) = push xs

84+ push (MetaBool x) = push x

85+ push (MetaString s) = push s

86+ push (MetaInlines ils) = push ils

87+ push (MetaBlocks bs) = push bs

88+

89+instance ToLuaStack Citation where

90+ push cit = do

91+ createtable 6 0

92+ addValue "citationId" $ citationId cit

93+ addValue "citationPrefix" $ citationPrefix cit

94+ addValue "citationSuffix" $ citationSuffix cit

95+ addValue "citationMode" $ show (citationMode cit)

96+ addValue "citationNoteNum" $ citationNoteNum cit

97+ addValue "citationHash" $ citationHash cit

11498

11599data PandocLuaException = PandocLuaException String

116100 deriving (Show, Typeable)

@@ -123,23 +107,22 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do

123107 luaScript <- UTF8.readFile luaFile

124108 enc <- getForeignEncoding

125109 setForeignEncoding utf8

126− lua <- Lua.newstate

127− Lua.openlibs lua

128− status <- loadstring lua luaScript luaFile

129− -- check for error in lua script (later we'll change the return type

130− -- to handle this more gracefully):

131− when (status /= 0) $

132− Lua.tostring lua 1 >>= throw . PandocLuaException . UTF8.toString

133− Lua.call lua 0 0

110+ (body, context) <- runLua $ do

111+ openlibs

112+ stat <- loadstring luaScript

113+ -- check for error in lua script (later we'll change the return type

114+ -- to handle this more gracefully):

115+ when (stat /= OK) $

116+ tostring 1 >>= throw . PandocLuaException . UTF8.toString

117+ call 0 0

134118 -- TODO - call hierarchicalize, so we have that info

135− rendered <- docToCustom lua opts doc

136− context <- metaToJSON opts

137− (blockListToCustom lua)

138− (inlineListToCustom lua)

139− meta

140− Lua.close lua

119+ rendered <- docToCustom opts doc

120+ context <- metaToJSON opts

121+ blockListToCustom

122+ inlineListToCustom

123+ meta

124+ return (rendered, context)

141125 setForeignEncoding enc

142− let body = rendered

143126 case writerTemplate opts of

144127 Nothing -> return $ pack body

145128 Just tpl ->

@@ -147,117 +130,115 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do

147130 Left e -> throw (PandocTemplateError e)

148131 Right r -> return (pack r)

149132

150−docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String

151−docToCustom lua opts (Pandoc (Meta metamap) blocks) = do

152− body <- blockListToCustom lua blocks

153− callfunc lua "Doc" body metamap (writerVariables opts)

133+docToCustom :: WriterOptions -> Pandoc -> Lua String

134+docToCustom opts (Pandoc (Meta metamap) blocks) = do

135+ body <- blockListToCustom blocks

136+ callFunc "Doc" body metamap (writerVariables opts)

154137

155138-- | Convert Pandoc block element to Custom.

156−blockToCustom :: LuaState -- ^ Lua state

157− -> Block -- ^ Block element

158− -> IO String

139+blockToCustom :: Block -- ^ Block element

140+ -> Lua String

159141

160−blockToCustom _ Null = return ""

142+blockToCustom Null = return ""

161143

162−blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines

144+blockToCustom (Plain inlines) = callFunc "Plain" inlines

163145

164−blockToCustom lua (Para [Image attr txt (src,tit)]) =

165− callfunc lua "CaptionedImage" src tit txt (attrToMap attr)

146+blockToCustom (Para [Image attr txt (src,tit)]) =

147+ callFunc "CaptionedImage" src tit txt (attrToMap attr)

166148

167−blockToCustom lua (Para inlines) = callfunc lua "Para" inlines

149+blockToCustom (Para inlines) = callFunc "Para" inlines

168150

169−blockToCustom lua (LineBlock linesList) = callfunc lua "LineBlock" linesList

151+blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList

170152

171−blockToCustom lua (RawBlock format str) =

172− callfunc lua "RawBlock" format str

153+blockToCustom (RawBlock format str) =

154+ callFunc "RawBlock" format str

173155

174−blockToCustom lua HorizontalRule = callfunc lua "HorizontalRule"

156+blockToCustom HorizontalRule = callFunc "HorizontalRule"

175157

176−blockToCustom lua (Header level attr inlines) =

177− callfunc lua "Header" level inlines (attrToMap attr)

158+blockToCustom (Header level attr inlines) =

159+ callFunc "Header" level inlines (attrToMap attr)

178160

179−blockToCustom lua (CodeBlock attr str) =

180− callfunc lua "CodeBlock" str (attrToMap attr)

161+blockToCustom (CodeBlock attr str) =

162+ callFunc "CodeBlock" str (attrToMap attr)

181163

182−blockToCustom lua (BlockQuote blocks) = callfunc lua "BlockQuote" blocks

164+blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks

183165

184−blockToCustom lua (Table capt aligns widths headers rows') =

185− callfunc lua "Table" capt (map show aligns) widths headers rows'

166+blockToCustom (Table capt aligns widths headers rows') =

167+ callFunc "Table" capt (map show aligns) widths headers rows'

186168

187−blockToCustom lua (BulletList items) = callfunc lua "BulletList" items

169+blockToCustom (BulletList items) = callFunc "BulletList" items

188170

189−blockToCustom lua (OrderedList (num,sty,delim) items) =

190− callfunc lua "OrderedList" items num (show sty) (show delim)

171+blockToCustom (OrderedList (num,sty,delim) items) =

172+ callFunc "OrderedList" items num (show sty) (show delim)

191173

192−blockToCustom lua (DefinitionList items) =

193− callfunc lua "DefinitionList" items

174+blockToCustom (DefinitionList items) =

175+ callFunc "DefinitionList" items

194176

195−blockToCustom lua (Div attr items) =

196− callfunc lua "Div" items (attrToMap attr)

177+blockToCustom (Div attr items) =

178+ callFunc "Div" items (attrToMap attr)

197179

198180-- | Convert list of Pandoc block elements to Custom.

199−blockListToCustom :: LuaState -- ^ Options

200− -> [Block] -- ^ List of block elements

201− -> IO String

202−blockListToCustom lua xs = do

203− blocksep <- callfunc lua "Blocksep"

204− bs <- mapM (blockToCustom lua) xs

181+blockListToCustom :: [Block] -- ^ List of block elements

182+ -> Lua String

183+blockListToCustom xs = do

184+ blocksep <- callFunc "Blocksep"

185+ bs <- mapM blockToCustom xs

205186 return $ mconcat $ intersperse blocksep bs

206187

207188-- | Convert list of Pandoc inline elements to Custom.

208−inlineListToCustom :: LuaState -> [Inline] -> IO String

209−inlineListToCustom lua lst = do

210− xs <- mapM (inlineToCustom lua) lst

211− return $ concat xs

189+inlineListToCustom :: [Inline] -> Lua String

190+inlineListToCustom lst = do

191+ xs <- mapM inlineToCustom lst

192+ return $ mconcat xs

212193

213194-- | Convert Pandoc inline element to Custom.

214−inlineToCustom :: LuaState -> Inline -> IO String

195+inlineToCustom :: Inline -> Lua String

215196

216−inlineToCustom lua (Str str) = callfunc lua "Str" str

197+inlineToCustom (Str str) = callFunc "Str" str

217198

218−inlineToCustom lua Space = callfunc lua "Space"

199+inlineToCustom Space = callFunc "Space"

219200

220−inlineToCustom lua SoftBreak = callfunc lua "SoftBreak"

201+inlineToCustom SoftBreak = callFunc "SoftBreak"

221202

222−inlineToCustom lua (Emph lst) = callfunc lua "Emph" lst

203+inlineToCustom (Emph lst) = callFunc "Emph" lst

223204

224−inlineToCustom lua (Strong lst) = callfunc lua "Strong" lst

205+inlineToCustom (Strong lst) = callFunc "Strong" lst

225206

226−inlineToCustom lua (Strikeout lst) = callfunc lua "Strikeout" lst

207+inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst

227208

228−inlineToCustom lua (Superscript lst) = callfunc lua "Superscript" lst

209+inlineToCustom (Superscript lst) = callFunc "Superscript" lst

229210

230−inlineToCustom lua (Subscript lst) = callfunc lua "Subscript" lst

211+inlineToCustom (Subscript lst) = callFunc "Subscript" lst

231212

232−inlineToCustom lua (SmallCaps lst) = callfunc lua "SmallCaps" lst

213+inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst

233214

234−inlineToCustom lua (Quoted SingleQuote lst) = callfunc lua "SingleQuoted" lst

215+inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst

235216

236−inlineToCustom lua (Quoted DoubleQuote lst) = callfunc lua "DoubleQuoted" lst

217+inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst

237218

238−inlineToCustom lua (Cite cs lst) = callfunc lua "Cite" lst cs

219+inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs

239220

240−inlineToCustom lua (Code attr str) =

241− callfunc lua "Code" str (attrToMap attr)

221+inlineToCustom (Code attr str) =

222+ callFunc "Code" str (attrToMap attr)

242223

243−inlineToCustom lua (Math DisplayMath str) =

244− callfunc lua "DisplayMath" str

224+inlineToCustom (Math DisplayMath str) =

225+ callFunc "DisplayMath" str

245226

246−inlineToCustom lua (Math InlineMath str) =

247− callfunc lua "InlineMath" str

227+inlineToCustom (Math InlineMath str) =

228+ callFunc "InlineMath" str

248229

249−inlineToCustom lua (RawInline format str) =

250− callfunc lua "RawInline" format str

230+inlineToCustom (RawInline format str) =

231+ callFunc "RawInline" format str

251232

252−inlineToCustom lua (LineBreak) = callfunc lua "LineBreak"

233+inlineToCustom (LineBreak) = callFunc "LineBreak"

253234

254−inlineToCustom lua (Link attr txt (src,tit)) =

255− callfunc lua "Link" txt src tit (attrToMap attr)

235+inlineToCustom (Link attr txt (src,tit)) =

236+ callFunc "Link" txt src tit (attrToMap attr)

256237

257−inlineToCustom lua (Image attr alt (src,tit)) =

258− callfunc lua "Image" alt src tit (attrToMap attr)

238+inlineToCustom (Image attr alt (src,tit)) =

239+ callFunc "Image" alt src tit (attrToMap attr)

259240

260−inlineToCustom lua (Note contents) = callfunc lua "Note" contents

241+inlineToCustom (Note contents) = callFunc "Note" contents

261242

262−inlineToCustom lua (Span attr items) =

263− callfunc lua "Span" items (attrToMap attr)

243+inlineToCustom (Span attr items) =

244+ callFunc "Span" items (attrToMap attr)

stack.full.yaml+1−1

@@ -20,6 +20,6 @@ packages:

2020- '../pandoc-types'

2121- '../texmath'

2222extra-deps:

23−- hslua-0.5.0

23+- hslua-0.7.0

2424- skylighting-0.3.3

2525resolver: lts-8.12

stack.pkg.yaml+1−1

@@ -17,7 +17,7 @@ packages:

1717 commit: 2e27f5cb40577c9b3ffe0fc112687084f3d9d877

1818 extra-dep: false

1919extra-deps:

20−- hslua-0.5.0

20+- hslua-0.7.0

2121- skylighting-0.3.3

2222- cmark-gfm-0.1.1

2323- QuickCheck-2.10.0.1

stack.yaml+1−1

@@ -7,7 +7,7 @@ flags:

77packages:

88- '.'

99extra-deps:

10−- hslua-0.5.0

10+- hslua-0.7.0

1111- skylighting-0.3.3

1212- cmark-gfm-0.1.1

1313- QuickCheck-2.10.0.1

test/Tests/Lua.hs+14−17

@@ -13,7 +13,7 @@ import Text.Pandoc.Builder ( (<>), bulletList, doc, doubleQuoted, emph

1313 , space, str, strong)

1414import Text.Pandoc.Lua

1515

16−import qualified Scripting.Lua as Lua

16+import Foreign.Lua

1717

1818tests :: [TestTree]

1919tests = map (localOption (QuickCheckTests 20))

@@ -71,23 +71,20 @@ assertFilterConversion msg filterPath docIn docExpected = do

7171 docRes <- runLuaFilter Nothing ("lua" </> filterPath) [] docIn

7272 assertEqual msg docExpected docRes

7373

74−roundtripEqual :: (Eq a, Lua.StackValue a) => a -> IO Bool

74+roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool

7575roundtripEqual x = (x ==) <$> roundtripped

7676 where

77− roundtripped :: (Lua.StackValue a) => IO a

78− roundtripped = do

79− lua <- Lua.newstate

80− Lua.openlibs lua

81− pushPandocModule Nothing lua

82− Lua.setglobal lua "pandoc"

83− oldSize <- Lua.gettop lua

84− Lua.push lua x

85− size <- Lua.gettop lua

77+ roundtripped :: (FromLuaStack a, ToLuaStack a) => IO a

78+ roundtripped = runLua $ do

79+ openlibs

80+ pushPandocModule Nothing

81+ setglobal "pandoc"

82+ oldSize <- gettop

83+ push x

84+ size <- gettop

8685 when ((size - oldSize) /= 1) $

8786 error ("not exactly one additional element on the stack: " ++ show size)

88− res <- Lua.peek lua (-1)

89− retval <- case res of

90− Nothing -> error "could not read from stack"

91− Just y -> return y

92− Lua.close lua

93− return retval

87+ res <- peekEither (-1)

88+ case res of

89+ Left _ -> error "could not read from stack"

90+ Right y -> return y