5d3573e · typeable/pandoc

git.iko.soy/typeable/pandoc

Lua modules: turn pipe, read into full Haskell functions

The `pipe` and `read` utility functions are converted from hybrid lua/haskell functions into full Haskell functions. This avoids the need for intermediate `_pipe`/`_read` helper functions, which have dropped.

commit5d3573e780d5056c87bb64858ea0890a27bc1686 authorAlbert Krewinkel <albert@zeitkraut.de> dateWed 20 Dec 2017, 21:59 (9 years ago) parent299e452

3 files changed+77−78

compare with master

unifiedsplit

data/pandoc.lua−47 src/Text/Pandoc/Lua/PandocModule.hs+65−28 src/Text/Pandoc/Lua/Util.hs+12−3

data/pandoc.lua−47

@@ -874,53 +874,6 @@ M.UpperAlpha = "UpperAlpha"

874874-- Helper Functions

875875-- @section helpers

876876

877−--- Parse the given string into a Pandoc document.

878−-- The method used to interpret input is specified by *format*. Acceptable

879−-- values for this parameter are equal to those that can be given to the

880−-- `--from` command line option.

881−-- @tparam string markup the markup to be parsed

882−-- @tparam[opt] string format format specification, defaults to "markdown".

883−-- @treturn Pandoc pandoc document

884−-- @usage

885−-- local org_markup = "/emphasis/" -- Input to be read

886−-- local document = pandoc.read(org_markup, "org")

887−-- -- Get the first block of the document

888−-- local block = document.blocks[1]

889−-- -- The inline element in that block is an `Emph`

890−-- assert(block.content[1].t == "Emph")

891−function M.read(markup, format)

892− format = format or "markdown"

893− local pd = pandoc._read(format, markup)

894− if type(pd) == "string" then

895− error(pd)

896− else

897− return pd

898− end

899−end

900−

901−--- Runs command with arguments, passing it some input, and returns the output.

902−-- @treturn string Output of command.

903−-- @raise A table containing the keys `command`, `error_code`, and `output` is

904−-- thrown if the command exits with a non-zero error code.

905−-- @usage

906−-- local ec, output = pandoc.pipe("sed", {"-e","s/a/b/"}, "abc")

907−function M.pipe (command, args, input)

908− local ec, output = pandoc._pipe(command, args, input)

909− if ec ~= 0 then

910− err = setmetatable(

911− { command = command, error_code = ec, output = output},

912− { __tostring = function(e)

913− return "Error running " .. e.command

914− .. " (error code " .. e.error_code .. "): "

915− .. e.output

916− end

917− }

918− )

919− error(err)

920− end

921− return output

922−end

923−

924877--- Use functions defined in the global namespace to create a pandoc filter.

925878-- All globally defined functions which have names of pandoc elements are

926879-- collected into a new table.

src/Text/Pandoc/Lua/PandocModule.hs+65−28

@@ -1,5 +1,3 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−{-# LANGUAGE FlexibleContexts #-}

31{-

@@ -17,7 +15,7 @@ You should have received a copy of the GNU General Public License

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

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

1917-}

20−{-# LANGUAGE CPP #-}

18+{-# LANGUAGE FlexibleContexts #-}

2119{- |

2220 Module : Text.Pandoc.Lua.PandocModule

@@ -33,21 +31,20 @@ module Text.Pandoc.Lua.PandocModule

3331 , pushMediaBagModule

3432 ) where

3533

36−import Control.Monad (zipWithM_)

34+import Control.Monad (when, zipWithM_)

3735import Data.Default (Default (..))

3836import Data.Digest.Pure.SHA (sha1, showDigest)

3937import Data.IORef (IORef, modifyIORef', readIORef)

4038import Data.Maybe (fromMaybe)

4139import Data.Text (pack)

4240import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)

43−import Foreign.Lua.FunctionCalling (ToHaskellFunction)

4441import System.Exit (ExitCode (..))

4542import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,

4643 runIO, runIOorExplode, setMediaBag)

4744import Text.Pandoc.Definition (Block, Inline)

4845import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)

4946import Text.Pandoc.Lua.StackInstances ()

50−import Text.Pandoc.Lua.Util (loadScriptFromDataDir)

47+import Text.Pandoc.Lua.Util (addFunction, addValue, loadScriptFromDataDir)

5148import Text.Pandoc.Walk (Walkable)

5249import Text.Pandoc.MIME (MimeType)

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

@@ -55,6 +52,7 @@ import Text.Pandoc.Process (pipeProcess)

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

5653

5754import qualified Data.ByteString.Lazy as BL

55+import qualified Data.ByteString.Lazy.Char8 as BSL

5856import qualified Foreign.Lua as Lua

5957import qualified Text.Pandoc.MediaBag as MB

6058

@@ -63,8 +61,8 @@ import qualified Text.Pandoc.MediaBag as MB

6361pushPandocModule :: Maybe FilePath -> Lua NumResults

6462pushPandocModule datadir = do

6563 loadScriptFromDataDir datadir "pandoc.lua"

66− addFunction "_pipe" pipeFn

67− addFunction "_read" readDoc

64+ addFunction "read" readDoc

65+ addFunction "pipe" pipeFn

6866 addFunction "sha1" sha1HashFn

6967 addFunction "walk_block" walkBlock

7068 addFunction "walk_inline" walkInline

@@ -80,19 +78,23 @@ walkInline = walkElement

8078walkBlock :: Block -> LuaFilter -> Lua Block

8179walkBlock = walkElement

8280

83−readDoc :: String -> String -> Lua NumResults

84−readDoc formatSpec content = do

81+readDoc :: String -> OrNil String -> Lua NumResults

82+readDoc content formatSpecOrNil = do

83+ let formatSpec = fromMaybe "markdown" (toMaybe formatSpecOrNil)

8584 case getReader formatSpec of

86− Left s -> Lua.push s -- Unknown reader

85+ Left s -> raiseError s -- Unknown reader

8786 Right (reader, es) ->

8887 case reader of

8988 TextReader r -> do

9089 res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)

9190 case res of

92− Left s -> Lua.push $ show s -- error while reading

93− Right pd -> Lua.push pd -- success, push Pandoc

94− _ -> Lua.push "Only string formats are supported at the moment."

95− return 1

91+ Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc

92+ Left s -> raiseError (show s) -- error while reading

93+ _ -> raiseError "Only string formats are supported at the moment."

94+ where

95+ raiseError s = do

96+ Lua.push s

97+ fromIntegral <$> Lua.lerror

9698

9799--

98100-- MediaBag submodule

@@ -106,29 +108,64 @@ pushMediaBagModule commonState mediaBagRef = do

106108 addFunction "fetch" (fetch commonState mediaBagRef)

107109 return 1

108110

109−addFunction :: ToHaskellFunction a => String -> a -> Lua ()

110−addFunction name fn = do

111− Lua.push name

112− Lua.pushHaskellFunction fn

113− Lua.rawset (-3)

114−

115111sha1HashFn :: BL.ByteString

116112 -> Lua NumResults

117113sha1HashFn contents = do

118114 Lua.push $ showDigest (sha1 contents)

119115 return 1

120116

117+-- | Pipes input through a command.

121118pipeFn :: String

122119 -> [String]

123120 -> BL.ByteString

124121 -> Lua NumResults

125122pipeFn command args input = do

126123 (ec, output) <- liftIO $ pipeProcess Nothing command args input

127− Lua.push $ case ec of

128− ExitSuccess -> 0

129− ExitFailure n -> n

130− Lua.push output

131− return 2

124+ case ec of

125+ ExitSuccess -> do

126+ Lua.push output

127+ return 1

128+ ExitFailure n -> do

129+ Lua.push (PipeError command n output)

130+ fromIntegral <$> Lua.lerror

131+

132+data PipeError = PipeError

133+ { pipeErrorCommand :: String

134+ , pipeErrorCode :: Int

135+ , pipeErrorOutput :: BL.ByteString

136+ }

137+

138+instance FromLuaStack PipeError where

139+ peek idx =

140+ PipeError

141+ <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1)

142+ <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)

143+ <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1)

144+

145+instance ToLuaStack PipeError where

146+ push pipeErr = do

147+ Lua.newtable

148+ addValue "command" (pipeErrorCommand pipeErr)

149+ addValue "error_code" (pipeErrorCode pipeErr)

150+ addValue "output" (pipeErrorOutput pipeErr)

151+ pushPipeErrorMetaTable

152+ Lua.setmetatable (-2)

153+ where

154+ pushPipeErrorMetaTable :: Lua ()

155+ pushPipeErrorMetaTable = do

156+ v <- Lua.newmetatable "pandoc pipe error"

157+ when v $ addFunction "__tostring" pipeErrorMessage

158+

159+ pipeErrorMessage :: PipeError -> Lua BL.ByteString

160+ pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat

161+ [ BSL.pack "Error running "

162+ , BSL.pack cmd

163+ , BSL.pack " (error code "

164+ , BSL.pack $ show errorCode

165+ , BSL.pack "): "

166+ , if output == mempty then BSL.pack "<no output>" else output

167+ ]

168+-- end: pipe

132169

133170insertMediaFn :: IORef MB.MediaBag

134171 -> FilePath

@@ -183,14 +220,14 @@ fetch commonState mbRef src = do

183220 return 2 -- returns 2 values: contents, mimetype

184221

185222--

186−-- Helper types and orphan instances

223+-- Helper types

187224--

188225

189226newtype OrNil a = OrNil { toMaybe :: Maybe a }

190227

191228instance FromLuaStack a => FromLuaStack (OrNil a) where

192229 peek idx = do

193− noValue <- Lua.isnil idx

230+ noValue <- Lua.isnoneornil idx

194231 if noValue

195232 then return (OrNil Nothing)

196233 else OrNil . Just <$> Lua.peek idx

src/Text/Pandoc/Lua/Util.hs+12−3

@@ -32,6 +32,7 @@ module Text.Pandoc.Lua.Util

3232 ( adjustIndexBy

3333 , getTable

3434 , addValue

35+ , addFunction

3536 , getRawInt

3637 , setRawInt

3738 , addRawInt

@@ -44,8 +45,8 @@ module Text.Pandoc.Lua.Util

4445

4546import Control.Monad (when)

4647import Data.ByteString.Char8 (unpack)

47−import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex,

48− ToLuaStack (..), getglobal')

48+import Foreign.Lua (FromLuaStack (..), ToHaskellFunction, Lua, NumArgs,

49+ StackIndex, ToLuaStack (..), getglobal')

4950import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti)

5051import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)

5152

@@ -66,13 +67,21 @@ getTable idx key = do

6667 rawget (idx `adjustIndexBy` 1)

6768 peek (-1) <* pop 1

6869

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

70+-- | Add a key-value pair to the table at the top of the stack.

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

7172addValue key value = do

7273 push key

7374 push value

7475 rawset (-3)

7576

77+-- | Add a function to the table at the top of the stack, using the given name.

78+addFunction :: ToHaskellFunction a => String -> a -> Lua ()

79+addFunction name fn = do

80+ Lua.push name

81+ Lua.pushHaskellFunction fn

82+ Lua.wrapHaskellFunction

83+ Lua.rawset (-3)

84+

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

7786getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a

7887getRawInt idx key =