From 7f54f76e8b5a7b45cd61a354980ef77f65baba20 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 26 Oct 2018 23:21:54 +0200 Subject: T.P.Lua: merge runLuaFilter into T.P.Filter.Lua (API change) The function `runLuaFilter` was only used in Text.Pandoc.Filter.Lua, use apply from the that module instead. --- src/Text/Pandoc/Filter.hs | 7 +++---- src/Text/Pandoc/Filter/Lua.hs | 47 +++++++++++++++++++++++++++++++++++-------- src/Text/Pandoc/Lua.hs | 40 ------------------------------------ test/Tests/Lua.hs | 15 +++++++------- 4 files changed, 49 insertions(+), 60 deletions(-) diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs index 5461648e1..8fe93089a 100644 --- a/src/Text/Pandoc/Filter.hs +++ b/src/Text/Pandoc/Filter.hs @@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} {- -Copyright (C) 2006-2017 John MacFarlane +Copyright (C) 2006-2018 John MacFarlane 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 @@ -16,11 +17,9 @@ 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 TemplateHaskell #-} - {- | Module : Text.Pandoc.Filter - Copyright : Copyright (C) 2006-2017 John MacFarlane + Copyright : Copyright (C) 2006-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs index d559fb912..6c78bef06 100644 --- a/src/Text/Pandoc/Filter/Lua.hs +++ b/src/Text/Pandoc/Filter/Lua.hs @@ -32,24 +32,55 @@ module Text.Pandoc.Filter.Lua (apply) where import Prelude import Control.Exception (throw) +import Control.Monad ((>=>)) +import Foreign.Lua (Lua) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Error (PandocError (PandocFilterError)) import Text.Pandoc.Filter.Path (expandFilterPath) -import Text.Pandoc.Lua (LuaException (..), runLuaFilter) +import Text.Pandoc.Lua (LuaException (..), runPandocLua) +import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) +import Text.Pandoc.Lua.Global (Global (..), setGlobals) +import Text.Pandoc.Lua.Util (dofileWithTraceback) import Text.Pandoc.Options (ReaderOptions) +import qualified Foreign.Lua as Lua + +-- | Run the Lua filter in @filterPath@ for a transformation to the +-- target format (first element in args). Pandoc uses Lua init files to +-- setup the Lua interpreter. apply :: ReaderOptions -> [String] -> FilePath -> Pandoc -> PandocIO Pandoc -apply ropts args f d = do - f' <- expandFilterPath f +apply ropts args f doc = do + filterPath <- expandFilterPath f let format = case args of (x:_) -> x - _ -> error "Format not supplied for lua filter" - res <- runLuaFilter ropts f' format d - case res of - Right x -> return x - Left (LuaException s) -> throw (PandocFilterError f s) + _ -> error "Format not supplied for Lua filter" + runPandocLua >=> forceResult filterPath $ do + setGlobals [ FORMAT format + , PANDOC_READER_OPTIONS ropts + , PANDOC_SCRIPT_FILE filterPath + ] + top <- Lua.gettop + stat <- dofileWithTraceback filterPath + if stat /= Lua.OK + then Lua.throwTopMessage + else do + newtop <- Lua.gettop + -- Use the returned filters, or the implicitly defined global + -- filter if nothing was returned. + luaFilters <- if newtop - top >= 1 + then Lua.peek Lua.stackTop + else Lua.pushglobaltable *> fmap (:[]) Lua.popValue + runAll luaFilters doc + +forceResult :: FilePath -> Either LuaException Pandoc -> PandocIO Pandoc +forceResult fp eitherResult = case eitherResult of + Right x -> return x + Left (LuaException s) -> throw (PandocFilterError fp s) + +runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc +runAll = foldr ((>=>) . walkMWithLuaFilter) return diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index de067823f..72e66808c 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -28,48 +28,8 @@ Running pandoc Lua filters. -} module Text.Pandoc.Lua ( LuaException (..) - , runLuaFilter , runPandocLua ) where -import Prelude -import Control.Monad ((>=>)) -import Foreign.Lua (Lua) -import Text.Pandoc.Class (PandocIO) -import Text.Pandoc.Definition (Pandoc) -import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) import Text.Pandoc.Lua.Init (LuaException (..), runPandocLua) -import Text.Pandoc.Lua.Util (dofileWithTraceback) -import Text.Pandoc.Options (ReaderOptions) -import qualified Foreign.Lua as Lua - --- | Run the Lua filter in @filterPath@ for a transformation to target --- format @format@. Pandoc uses Lua init files to setup the Lua --- interpreter. -runLuaFilter :: ReaderOptions -> FilePath -> String - -> Pandoc -> PandocIO (Either LuaException Pandoc) -runLuaFilter ropts filterPath format doc = runPandocLua $ do - setGlobals globals - top <- Lua.gettop - stat <- dofileWithTraceback filterPath - if stat /= Lua.OK - then Lua.throwTopMessage - else do - newtop <- Lua.gettop - -- Use the returned filters, or the implicitly defined global filter if - -- nothing was returned. - luaFilters <- if newtop - top >= 1 - then Lua.peek Lua.stackTop - else Lua.pushglobaltable *> fmap (:[]) Lua.popValue - runAll luaFilters doc - - where - globals = [ FORMAT format - , PANDOC_READER_OPTIONS ropts - , PANDOC_SCRIPT_FILE filterPath - ] - -runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc -runAll = foldr ((>=>) . walkMWithLuaFilter) return diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 3fe9c1121..1d07829f5 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -7,7 +7,7 @@ import Control.Monad (when) import Data.Version (Version (versionBranch)) import System.FilePath (()) import Test.Tasty (TestTree, localOption) -import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase) +import Test.Tasty.HUnit (Assertion, assertEqual, testCase) import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty) import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph, @@ -17,7 +17,8 @@ import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph, import Text.Pandoc.Class (runIOorExplode, setUserDataDir) import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str), Attr, Meta, Pandoc, pandocTypesVersion) -import Text.Pandoc.Lua (runLuaFilter, runPandocLua) +import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters) +import Text.Pandoc.Lua (runPandocLua) import Text.Pandoc.Options (def) import Text.Pandoc.Shared (pandocVersion) @@ -174,13 +175,11 @@ tests = map (localOption (QuickCheckTests 20)) ] assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion -assertFilterConversion msg filterPath docIn docExpected = do - docEither <- runIOorExplode $ do +assertFilterConversion msg filterPath docIn expectedDoc = do + actualDoc <- runIOorExplode $ do setUserDataDir (Just "../data") - runLuaFilter def ("lua" filterPath) [] docIn - case docEither of - Left exception -> assertFailure (show exception) - Right docRes -> assertEqual msg docExpected docRes + applyFilters def [LuaFilter ("lua" filterPath)] ["HTML"] docIn + assertEqual msg expectedDoc actualDoc roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool roundtripEqual x = (x ==) <$> roundtripped -- cgit v1.2.3