71f69cd · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Allow lua filters to return lists of elements

71f69cdAlbert Krewinkel9 years ago

src/Text/Pandoc/Lua.hs+75−46

compare with master

unifiedsplit

@@ -1,8 +1,9 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE DeriveDataTypeable #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+{-# OPTIONS_GHC -fno-warn-orphans #-}

6{-

7{-

@@ -33,6 +34,7 @@ Pandoc lua utils.

33module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where

34module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where

35import Control.Monad (mplus, unless, when, (>=>))

36import Control.Monad (mplus, unless, when, (>=>))

37+import Control.Monad.Identity (Identity)

36import Control.Monad.Trans (MonadIO (..))

38import Control.Monad.Trans (MonadIO (..))

37import Data.Data (DataType, Data, toConstr, showConstr, dataTypeOf,

39import Data.Data (DataType, Data, toConstr, showConstr, dataTypeOf,

38 dataTypeConstrs, dataTypeName, tyconUQname)

40 dataTypeConstrs, dataTypeName, tyconUQname)

@@ -40,10 +42,10 @@ import Data.Foldable (foldrM)

40import Data.Map (Map)

42import Data.Map (Map)

41import Data.Maybe (isJust)

43import Data.Maybe (isJust)

42import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex,

44import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex,

43− Status(OK), ToLuaStack (push))

45+ Status (OK), ToLuaStack (push))

44import Text.Pandoc.Definition

46import Text.Pandoc.Definition

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

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

46−import Text.Pandoc.Walk (Walkable (walkM))

48+import Text.Pandoc.Walk (walkM)

48import qualified Data.Map as Map

50import qualified Data.Map as Map

49import qualified Foreign.Lua as Lua

51import qualified Foreign.Lua as Lua

@@ -56,7 +58,7 @@ runLuaFilter datadir filterPath args pd = liftIO . Lua.runLua $ do

56 pushPandocModule datadir

58 pushPandocModule datadir

57 Lua.setglobal "pandoc"

59 Lua.setglobal "pandoc"

58 top <- Lua.gettop

60 top <- Lua.gettop

59− stat<- Lua.dofile filterPath

61+ stat <- Lua.dofile filterPath

60 if stat /= OK

62 if stat /= OK

61 then do

63 then do

62 luaErrMsg <- peek (-1) <* Lua.pop 1

64 luaErrMsg <- peek (-1) <* Lua.pop 1

@@ -64,7 +66,7 @@ runLuaFilter datadir filterPath args pd = liftIO . Lua.runLua $ do

64 else do

66 else do

65 newtop <- Lua.gettop

67 newtop <- Lua.gettop

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

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

67− when (newtop - top < 1) $ pushGlobalFilter

69+ when (newtop - top < 1) pushGlobalFilter

68 luaFilters <- peek (-1)

70 luaFilters <- peek (-1)

69 push args

71 push args

70 Lua.setglobal "PandocParameters"

72 Lua.setglobal "PandocParameters"

@@ -81,27 +83,36 @@ runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc

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

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

83walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc

85walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc

84−walkMWithLuaFilter (LuaFilter fnMap) = walkLua

86+walkMWithLuaFilter (LuaFilter fnMap) =

87+ walkInlines >=> walkBlocks >=> walkMeta >=> walkPandoc

85− where

88+ where

86− walkLua :: Pandoc -> Lua Pandoc

89+ walkInlines :: Pandoc -> Lua Pandoc

87− walkLua =

90+ walkInlines =

88− (if hasOneOf inlineFilterNames

91+ if hasOneOf inlineFilterNames

89− then walkM (tryFilter fnMap :: Inline -> Lua Inline)

92+ then walkM (mconcatMapM (tryFilter fnMap :: Inline -> Lua [Inline]))

90− else return)

93+ else return

91− >=>

94+

95+ walkBlocks :: Pandoc -> Lua Pandoc

96+ walkBlocks =

92− (if hasOneOf blockFilterNames

97+ if hasOneOf blockFilterNames

93− then walkM (tryFilter fnMap :: Block -> Lua Block)

98+ then walkM (mconcatMapM (tryFilter fnMap :: Block -> Lua [Block]))

94− else return)

99+ else return

95− >=>

100+

101+ walkMeta :: Pandoc -> Lua Pandoc

102+ walkMeta =

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

103+ case Map.lookup "Meta" fnMap of

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

104+ Just fn -> walkM (\(Pandoc meta blocks) -> do

98− meta' <- runFilterFunction fn meta

105+ meta' <- runFilterFunction fn meta *> singleElement meta

99− return $ Pandoc meta' blocks)

106+ return $ Pandoc meta' blocks)

100− Nothing -> return)

107+ Nothing -> return

101− >=>

108+

109+ walkPandoc :: Pandoc -> Lua Pandoc

110+ walkPandoc =

102− (case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of

111+ case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of

103− Just fn -> runFilterFunction fn :: Pandoc -> Lua Pandoc

112+ Just fn -> \x -> runFilterFunction fn x *> singleElement x

104− Nothing -> return)

113+ Nothing -> return

114+

115+ mconcatMapM f = fmap mconcat . mapM f

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

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

106

117

107constructorsFor :: DataType -> [String]

118constructorsFor :: DataType -> [String]

@@ -124,14 +135,15 @@ newtype LuaFilter = LuaFilter FunctionMap

124newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }

135newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }

125

136

126-- | Try running a filter for the given element

137-- | Try running a filter for the given element

127−tryFilter :: (Data a, FromLuaStack a, ToLuaStack a) => FunctionMap -> a -> Lua a

138+tryFilter :: (Data a, FromLuaStack a, ToLuaStack a)

139+ => FunctionMap -> a -> Lua [a]

128tryFilter fnMap x =

140tryFilter fnMap x =

129 let filterFnName = showConstr (toConstr x)

141 let filterFnName = showConstr (toConstr x)

130 catchAllName = tyconUQname $ dataTypeName (dataTypeOf x)

142 catchAllName = tyconUQname $ dataTypeName (dataTypeOf x)

131 in

143 in

132 case Map.lookup filterFnName fnMap `mplus` Map.lookup catchAllName fnMap of

144 case Map.lookup filterFnName fnMap `mplus` Map.lookup catchAllName fnMap of

133− Just fn -> runFilterFunction fn x

145+ Just fn -> runFilterFunction fn x *> elementOrList x

134− Nothing -> return x

146+ Nothing -> return [x]

135

147

136instance FromLuaStack LuaFilter where

148instance FromLuaStack LuaFilter where

137 peek idx =

149 peek idx =

@@ -151,28 +163,42 @@ instance FromLuaStack LuaFilter where

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

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

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

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

153-- element is left unchanged.

165-- element is left unchanged.

154−runFilterFunction :: (FromLuaStack a, ToLuaStack a)

166+runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()

155− => LuaFilterFunction -> a -> Lua a

156runFilterFunction lf x = do

167runFilterFunction lf x = do

157 pushFilterFunction lf

168 pushFilterFunction lf

158 push x

169 push x

159 z <- Lua.pcall 1 1 Nothing

170 z <- Lua.pcall 1 1 Nothing

160− if z /= OK

171+ when (z /= OK) $ do

161− then do

162− msg <- peek (-1)

172+ msg <- Lua.peek (-1) <* Lua.pop 1

163− let prefix = "Error while running filter function: "

173+ let prefix = "Error while running filter function: "

164− Lua.throwLuaError $ prefix ++ msg

174+ Lua.throwLuaError $ prefix ++ msg

175+

176+elementOrList :: FromLuaStack a => a -> Lua [a]

177+elementOrList x = do

178+ let topOfStack = Lua.StackIndex (-1)

179+ elementUnchanged <- Lua.isnil topOfStack

180+ if elementUnchanged

181+ then [x] <$ Lua.pop 1

182+ else do

183+ mbres <- Lua.peekEither topOfStack

184+ case mbres of

185+ Right res -> [res] <$ Lua.pop 1

186+ Left _ -> Lua.toList topOfStack <* Lua.pop 1

187+

188+singleElement :: FromLuaStack a => a -> Lua a

189+singleElement x = do

190+ elementUnchanged <- Lua.isnil (-1)

191+ if elementUnchanged

192+ then x <$ Lua.pop 1

165 else do

193 else do

166− noExplicitFilter <- Lua.isnil (-1)

167− if noExplicitFilter

168− then Lua.pop 1 *> return x

169− else do

170− mbres <- Lua.peekEither (-1)

194+ mbres <- Lua.peekEither (-1)

171− case mbres of

195+ case mbres of

196+ Right res -> res <$ Lua.pop 1

197+ Left err -> do

198+ Lua.pop 1

172− Left err -> Lua.throwLuaError

199+ Lua.throwLuaError $

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

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

174− ++ "value from lua stack.\n" ++ err)

201+ "value from lua stack.\n" ++ err

175− Right res -> res <$ Lua.pop 1

176

202

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

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

178pushFilterFunction :: LuaFilterFunction -> Lua ()

204pushFilterFunction :: LuaFilterFunction -> Lua ()

@@ -188,6 +214,9 @@ registerFilterFunction idx = do

188 refIdx <- Lua.ref Lua.registryindex

214 refIdx <- Lua.ref Lua.registryindex

189 return $ LuaFilterFunction refIdx

215 return $ LuaFilterFunction refIdx

190

216

217+instance (FromLuaStack a) => FromLuaStack (Identity a) where

218+ peek = fmap return . peek

219+

191instance ToLuaStack LuaFilterFunction where

220instance ToLuaStack LuaFilterFunction where

192 push = pushFilterFunction

221 push = pushFilterFunction

193

222

src/Text/Pandoc/Lua/StackInstances.hs+15−15

@@ -35,14 +35,15 @@ module Text.Pandoc.Lua.StackInstances () where

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

36import Foreign.Lua (Lua, LuaInteger, LuaNumber, Type (..), FromLuaStack (peek),

37 ToLuaStack (push), StackIndex, throwLuaError, tryLua)

38−import Foreign.Lua.Api (getmetatable, ltype, newtable, pop, rawget, rawlen)

39import Text.Pandoc.Definition

38import Text.Pandoc.Definition

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

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

41import Text.Pandoc.Shared (safeRead)

40import Text.Pandoc.Shared (safeRead)

42+import qualified Foreign.Lua as Lua

43+

43instance ToLuaStack Pandoc where

44instance ToLuaStack Pandoc where

44 push (Pandoc meta blocks) = do

45 push (Pandoc meta blocks) = do

45− newtable

46+ Lua.newtable

46 addValue "blocks" blocks

47 addValue "blocks" blocks

47 addValue "meta" meta

48 addValue "meta" meta

@@ -156,7 +157,7 @@ peekMetaValue idx = do

156 -- Get the contents of an AST element.

157 -- Get the contents of an AST element.

157 let elementContent :: FromLuaStack a => Lua a

158 let elementContent :: FromLuaStack a => Lua a

158 elementContent = peek idx

159 elementContent = peek idx

159− luatype <- ltype idx

160+ luatype <- Lua.ltype idx

160 case luatype of

161 case luatype of

161 TypeBoolean -> MetaBool <$> peek idx

162 TypeBoolean -> MetaBool <$> peek idx

162 TypeString -> MetaString <$> peek idx

163 TypeString -> MetaString <$> peek idx

@@ -172,13 +173,13 @@ peekMetaValue idx = do

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

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

173 Left _ -> do

174 Left _ -> do

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

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

175− len <- rawlen idx

176+ len <- Lua.rawlen idx

176 if len <= 0

177 if len <= 0

177 then MetaMap <$> peek idx

178 then MetaMap <$> peek idx

178 else (MetaInlines <$> peek idx)

179 else (MetaInlines <$> peek idx)

179 <|> (MetaBlocks <$> peek idx)

180 <|> (MetaBlocks <$> peek idx)

180 <|> (MetaList <$> peek idx)

181 <|> (MetaList <$> peek idx)

181− _ -> throwLuaError ("could not get meta value")

182+ _ -> throwLuaError "could not get meta value"

182

183

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

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

184pushBlock :: Block -> Lua ()

185pushBlock :: Block -> Lua ()

@@ -284,16 +285,15 @@ peekInline idx = do

284

285

285getTag :: StackIndex -> Lua String

286getTag :: StackIndex -> Lua String

286getTag idx = do

287getTag idx = do

288+ top <- Lua.gettop

287− hasMT <- getmetatable idx

289+ hasMT <- Lua.getmetatable idx

288− if hasMT

290+ push "tag"

289− then do

290− push "tag"

291− rawget (-2)

292− peek (-1) <* pop 2

293− else do

294− push "tag"

295− rawget (idx `adjustIndexBy` 1)

291+ if hasMT then Lua.rawget (-2) else Lua.rawget (idx `adjustIndexBy` 1)

296− peek (-1) <* pop 1

292+ r <- tryLua (peek (-1))

293+ Lua.settop top

294+ case r of

295+ Left (Lua.LuaException err) -> throwLuaError err

296+ Right res -> return res

297

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

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

test/lua/undiv.luanew file+3

@@ -0,0 +1,3 @@

1+function Div(el)

2+ return el.content

3+end