@@ -1,8 +1,9 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
67{-
78Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
89
@@ -33,6 +34,7 @@ Pandoc lua utils.
3334module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where
3435
3536import Control.Monad (mplus, unless, when, (>=>))
37+import Control.Monad.Identity (Identity)
3638import Control.Monad.Trans (MonadIO (..))
3739import Data.Data (DataType, Data, toConstr, showConstr, dataTypeOf,
3840 dataTypeConstrs, dataTypeName, tyconUQname)
@@ -40,10 +42,10 @@ import Data.Foldable (foldrM)
4042import Data.Map (Map)
4143import Data.Maybe (isJust)
4244import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex,
43− Status(OK), ToLuaStack (push))
45+ Status (OK), ToLuaStack (push))
4446import Text.Pandoc.Definition
4547import Text.Pandoc.Lua.PandocModule (pushPandocModule)
46−import Text.Pandoc.Walk (Walkable (walkM))
48+import Text.Pandoc.Walk (walkM)
4749
4850import qualified Data.Map as Map
4951import qualified Foreign.Lua as Lua
@@ -56,7 +58,7 @@ runLuaFilter datadir filterPath args pd = liftIO . Lua.runLua $ do
5658 pushPandocModule datadir
5759 Lua.setglobal "pandoc"
5860 top <- Lua.gettop
59− stat<- Lua.dofile filterPath
61+ stat <- Lua.dofile filterPath
6062 if stat /= OK
6163 then do
6264 luaErrMsg <- peek (-1) <* Lua.pop 1
@@ -64,7 +66,7 @@ runLuaFilter datadir filterPath args pd = liftIO . Lua.runLua $ do
6466 else do
6567 newtop <- Lua.gettop
6668 -- Use the implicitly defined global filter if nothing was returned
67− when (newtop - top < 1) $ pushGlobalFilter
69+ when (newtop - top < 1) pushGlobalFilter
6870 luaFilters <- peek (-1)
6971 push args
7072 Lua.setglobal "PandocParameters"
@@ -81,27 +83,36 @@ runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
8183runAll = foldr ((>=>) . walkMWithLuaFilter) return
8284
8385walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
84−walkMWithLuaFilter (LuaFilter fnMap) = walkLua
85− where
86− walkLua :: Pandoc -> Lua Pandoc
87− walkLua =
88− (if hasOneOf inlineFilterNames
89− then walkM (tryFilter fnMap :: Inline -> Lua Inline)
90− else return)
91− >=>
92− (if hasOneOf blockFilterNames
93− then walkM (tryFilter fnMap :: Block -> Lua Block)
94− else return)
95− >=>
96− (case Map.lookup "Meta" fnMap of
97− Just fn -> walkM (\(Pandoc meta blocks) -> do
98− meta' <- runFilterFunction fn meta
99− return $ Pandoc meta' blocks)
100− Nothing -> return)
101− >=>
102− (case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of
103− Just fn -> runFilterFunction fn :: Pandoc -> Lua Pandoc
104− Nothing -> return)
86+walkMWithLuaFilter (LuaFilter fnMap) =
87+ walkInlines >=> walkBlocks >=> walkMeta >=> walkPandoc
88+ where
89+ walkInlines :: Pandoc -> Lua Pandoc
90+ walkInlines =
91+ if hasOneOf inlineFilterNames
92+ then walkM (mconcatMapM (tryFilter fnMap :: Inline -> Lua [Inline]))
93+ else return
94+
95+ walkBlocks :: Pandoc -> Lua Pandoc
96+ walkBlocks =
97+ if hasOneOf blockFilterNames
98+ then walkM (mconcatMapM (tryFilter fnMap :: Block -> Lua [Block]))
99+ else return
100+
101+ walkMeta :: Pandoc -> Lua Pandoc
102+ walkMeta =
103+ case Map.lookup "Meta" fnMap of
104+ Just fn -> walkM (\(Pandoc meta blocks) -> do
105+ meta' <- runFilterFunction fn meta *> singleElement meta
106+ return $ Pandoc meta' blocks)
107+ Nothing -> return
108+
109+ walkPandoc :: Pandoc -> Lua Pandoc
110+ walkPandoc =
111+ case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of
112+ Just fn -> \x -> runFilterFunction fn x *> singleElement x
113+ Nothing -> return
114+
115+ mconcatMapM f = fmap mconcat . mapM f
105116 hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
106117
107118constructorsFor :: DataType -> [String]
@@ -124,14 +135,15 @@ newtype LuaFilter = LuaFilter FunctionMap
124135newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
125136
126137-- | 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]
128140tryFilter fnMap x =
129141 let filterFnName = showConstr (toConstr x)
130142 catchAllName = tyconUQname $ dataTypeName (dataTypeOf x)
131143 in
132144 case Map.lookup filterFnName fnMap `mplus` Map.lookup catchAllName fnMap of
133− Just fn -> runFilterFunction fn x
134− Nothing -> return x
145+ Just fn -> runFilterFunction fn x *> elementOrList x
146+ Nothing -> return [x]
135147
136148instance FromLuaStack LuaFilter where
137149 peek idx =
@@ -151,28 +163,42 @@ instance FromLuaStack LuaFilter where
151163-- called with given element as argument and is expected to return an element.
152164-- Alternatively, the function can return nothing or nil, in which case the
153165-- element is left unchanged.
154−runFilterFunction :: (FromLuaStack a, ToLuaStack a)
155− => LuaFilterFunction -> a -> Lua a
166+runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()
156167runFilterFunction lf x = do
157168 pushFilterFunction lf
158169 push x
159170 z <- Lua.pcall 1 1 Nothing
160− if z /= OK
161− then do
162− msg <- peek (-1)
163− let prefix = "Error while running filter function: "
164− Lua.throwLuaError $ prefix ++ msg
171+ when (z /= OK) $ do
172+ msg <- Lua.peek (-1) <* Lua.pop 1
173+ let prefix = "Error while running filter function: "
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
165193 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)
171− case mbres of
172− Left err -> Lua.throwLuaError
173− ("Error while trying to get a filter's return "
174− ++ "value from lua stack.\n" ++ err)
175− Right res -> res <$ Lua.pop 1
194+ mbres <- Lua.peekEither (-1)
195+ case mbres of
196+ Right res -> res <$ Lua.pop 1
197+ Left err -> do
198+ Lua.pop 1
199+ Lua.throwLuaError $
200+ "Error while trying to get a filter's return " ++
201+ "value from lua stack.\n" ++ err
176202
177203-- | Push the filter function to the top of the stack.
178204pushFilterFunction :: LuaFilterFunction -> Lua ()
@@ -188,6 +214,9 @@ registerFilterFunction idx = do
188214 refIdx <- Lua.ref Lua.registryindex
189215 return $ LuaFilterFunction refIdx
190216
217+instance (FromLuaStack a) => FromLuaStack (Identity a) where
218+ peek = fmap return . peek
219+
191220instance ToLuaStack LuaFilterFunction where
192221 push = pushFilterFunction
193222