aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Lua
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Lua')
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs (renamed from src/Text/Pandoc/Lua/PandocModule.hs)106
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs135
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs50
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs9
-rw-r--r--src/Text/Pandoc/Lua/Util.hs33
5 files changed, 230 insertions, 103 deletions
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 6bc2618fd..33c441c99 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
{-
Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -17,88 +15,39 @@ 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 CPP #-}
{- |
- Module : Text.Pandoc.Lua.PandocModule
+ Module : Text.Pandoc.Lua.Module.MediaBag
Copyright : Copyright © 2017 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
-Pandoc module for lua.
+The lua module @pandoc.mediabag@.
-}
-module Text.Pandoc.Lua.PandocModule
- ( pushPandocModule
- , pushMediaBagModule
+module Text.Pandoc.Lua.Module.MediaBag
+ ( pushModule
) where
import Control.Monad (zipWithM_)
-import Data.Default (Default (..))
-import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.IORef (IORef, modifyIORef', readIORef)
import Data.Maybe (fromMaybe)
-import Data.Text (pack)
-import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
-import Foreign.Lua.FunctionCalling (ToHaskellFunction)
-import System.Exit (ExitCode (..))
+import Foreign.Lua (Lua, NumResults, liftIO)
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
- runIO, runIOorExplode, setMediaBag)
-import Text.Pandoc.Definition (Block, Inline)
-import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
+ runIOorExplode, setMediaBag)
import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
-import Text.Pandoc.Walk (Walkable)
+import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction)
import Text.Pandoc.MIME (MimeType)
-import Text.Pandoc.Options (ReaderOptions (readerExtensions))
-import Text.Pandoc.Process (pipeProcess)
-import Text.Pandoc.Readers (Reader (..), getReader)
import qualified Data.ByteString.Lazy as BL
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.MediaBag as MB
--- | Push the "pandoc" on the lua stack. Requires the `list` module to be
--- loaded.
-pushPandocModule :: Maybe FilePath -> Lua NumResults
-pushPandocModule datadir = do
- loadScriptFromDataDir datadir "pandoc.lua"
- addFunction "_pipe" pipeFn
- addFunction "_read" readDoc
- addFunction "sha1" sha1HashFn
- addFunction "walk_block" walkBlock
- addFunction "walk_inline" walkInline
- return 1
-
-walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a)
- => a -> LuaFilter -> Lua a
-walkElement x f = walkInlines f x >>= walkBlocks f
-
-walkInline :: Inline -> LuaFilter -> Lua Inline
-walkInline = walkElement
-
-walkBlock :: Block -> LuaFilter -> Lua Block
-walkBlock = walkElement
-
-readDoc :: String -> String -> Lua NumResults
-readDoc formatSpec content = do
- case getReader formatSpec of
- Left s -> Lua.push s -- Unknown reader
- Right (reader, es) ->
- case reader of
- TextReader r -> do
- res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
- case res of
- Left s -> Lua.push $ show s -- error while reading
- Right pd -> Lua.push pd -- success, push Pandoc
- _ -> Lua.push "Only string formats are supported at the moment."
- return 1
-
--
-- MediaBag submodule
--
-pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
-pushMediaBagModule commonState mediaBagRef = do
+pushModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
+pushModule commonState mediaBagRef = do
Lua.newtable
addFunction "insert" (insertMediaFn mediaBagRef)
addFunction "lookup" (lookupMediaFn mediaBagRef)
@@ -106,30 +55,6 @@ pushMediaBagModule commonState mediaBagRef = do
addFunction "fetch" (fetch commonState mediaBagRef)
return 1
-addFunction :: ToHaskellFunction a => String -> a -> Lua ()
-addFunction name fn = do
- Lua.push name
- Lua.pushHaskellFunction fn
- Lua.rawset (-3)
-
-sha1HashFn :: BL.ByteString
- -> Lua NumResults
-sha1HashFn contents = do
- Lua.push $ showDigest (sha1 contents)
- return 1
-
-pipeFn :: String
- -> [String]
- -> BL.ByteString
- -> Lua NumResults
-pipeFn command args input = do
- (ec, output) <- liftIO $ pipeProcess Nothing command args input
- Lua.push $ case ec of
- ExitSuccess -> 0
- ExitFailure n -> n
- Lua.push output
- return 2
-
insertMediaFn :: IORef MB.MediaBag
-> FilePath
-> OrNil MimeType
@@ -181,16 +106,3 @@ fetch commonState mbRef src = do
Lua.push $ fromMaybe "" mimeType
Lua.push bs
return 2 -- returns 2 values: contents, mimetype
-
---
--- Helper types and orphan instances
---
-
-newtype OrNil a = OrNil { toMaybe :: Maybe a }
-
-instance FromLuaStack a => FromLuaStack (OrNil a) where
- peek idx = do
- noValue <- Lua.isnil idx
- if noValue
- then return (OrNil Nothing)
- else OrNil . Just <$> Lua.peek idx
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
new file mode 100644
index 000000000..5b8714e07
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -0,0 +1,135 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+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
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+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 FlexibleContexts #-}
+{- |
+ Module : Text.Pandoc.Lua.Module.Pandoc
+ Copyright : Copyright © 2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Pandoc module for lua.
+-}
+module Text.Pandoc.Lua.Module.Pandoc
+ ( pushModule
+ ) where
+
+import Control.Monad (when)
+import Data.Default (Default (..))
+import Data.Maybe (fromMaybe)
+import Data.Text (pack)
+import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO)
+import System.Exit (ExitCode (..))
+import Text.Pandoc.Class (runIO)
+import Text.Pandoc.Definition (Block, Inline)
+import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
+import Text.Pandoc.Lua.StackInstances ()
+import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction, addValue,
+ loadScriptFromDataDir, raiseError)
+import Text.Pandoc.Walk (Walkable)
+import Text.Pandoc.Options (ReaderOptions (readerExtensions))
+import Text.Pandoc.Process (pipeProcess)
+import Text.Pandoc.Readers (Reader (..), getReader)
+
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import qualified Foreign.Lua as Lua
+
+-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
+-- loaded.
+pushModule :: Maybe FilePath -> Lua NumResults
+pushModule datadir = do
+ loadScriptFromDataDir datadir "pandoc.lua"
+ addFunction "read" readDoc
+ addFunction "pipe" pipeFn
+ addFunction "walk_block" walkBlock
+ addFunction "walk_inline" walkInline
+ return 1
+
+walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a)
+ => a -> LuaFilter -> Lua a
+walkElement x f = walkInlines f x >>= walkBlocks f
+
+walkInline :: Inline -> LuaFilter -> Lua Inline
+walkInline = walkElement
+
+walkBlock :: Block -> LuaFilter -> Lua Block
+walkBlock = walkElement
+
+readDoc :: String -> OrNil String -> Lua NumResults
+readDoc content formatSpecOrNil = do
+ let formatSpec = fromMaybe "markdown" (toMaybe formatSpecOrNil)
+ case getReader formatSpec of
+ Left s -> raiseError s -- Unknown reader
+ Right (reader, es) ->
+ case reader of
+ TextReader r -> do
+ res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
+ case res of
+ Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc
+ Left s -> raiseError (show s) -- error while reading
+ _ -> raiseError "Only string formats are supported at the moment."
+
+-- | Pipes input through a command.
+pipeFn :: String
+ -> [String]
+ -> BL.ByteString
+ -> Lua NumResults
+pipeFn command args input = do
+ (ec, output) <- liftIO $ pipeProcess Nothing command args input
+ case ec of
+ ExitSuccess -> 1 <$ Lua.push output
+ ExitFailure n -> raiseError (PipeError command n output)
+
+data PipeError = PipeError
+ { pipeErrorCommand :: String
+ , pipeErrorCode :: Int
+ , pipeErrorOutput :: BL.ByteString
+ }
+
+instance FromLuaStack PipeError where
+ peek idx =
+ PipeError
+ <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
+ <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1)
+
+instance ToLuaStack PipeError where
+ push pipeErr = do
+ Lua.newtable
+ addValue "command" (pipeErrorCommand pipeErr)
+ addValue "error_code" (pipeErrorCode pipeErr)
+ addValue "output" (pipeErrorOutput pipeErr)
+ pushPipeErrorMetaTable
+ Lua.setmetatable (-2)
+ where
+ pushPipeErrorMetaTable :: Lua ()
+ pushPipeErrorMetaTable = do
+ v <- Lua.newmetatable "pandoc pipe error"
+ when v $ addFunction "__tostring" pipeErrorMessage
+
+ pipeErrorMessage :: PipeError -> Lua BL.ByteString
+ pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat
+ [ BSL.pack "Error running "
+ , BSL.pack cmd
+ , BSL.pack " (error code "
+ , BSL.pack $ show errorCode
+ , BSL.pack "): "
+ , if output == mempty then BSL.pack "<no output>" else output
+ ]
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
new file mode 100644
index 000000000..496fdbc0a
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -0,0 +1,50 @@
+{-
+Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+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
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+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
+-}
+{- |
+ Module : Text.Pandoc.Lua.Module.Utils
+ Copyright : Copyright © 2017 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Utility module for lua, exposing internal helper functions.
+-}
+module Text.Pandoc.Lua.Module.Utils
+ ( pushModule
+ ) where
+
+import Data.Digest.Pure.SHA (sha1, showDigest)
+import Foreign.Lua (Lua, NumResults)
+import Text.Pandoc.Lua.StackInstances ()
+import Text.Pandoc.Lua.Util (addFunction)
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Foreign.Lua as Lua
+
+-- | Push the "pandoc.utils" module to the lua stack.
+pushModule :: Lua NumResults
+pushModule = do
+ Lua.newtable
+ addFunction "sha1" sha1HashFn
+ return 1
+
+-- | Calculate the hash of the given contents.
+sha1HashFn :: BSL.ByteString
+ -> Lua String
+sha1HashFn = return . showDigest . sha1
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index b2dbff496..f26c17084 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/src/Text/Pandoc/Lua/Packages.hs
@@ -38,10 +38,12 @@ import Data.IORef (IORef)
import Foreign.Lua (Lua, NumResults, liftIO)
import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir)
import Text.Pandoc.MediaBag (MediaBag)
-import Text.Pandoc.Lua.PandocModule (pushPandocModule, pushMediaBagModule)
import Text.Pandoc.Lua.Util (dostring')
import qualified Foreign.Lua as Lua
+import Text.Pandoc.Lua.Module.Pandoc as Pandoc
+import Text.Pandoc.Lua.Module.MediaBag as MediaBag
+import Text.Pandoc.Lua.Module.Utils as Utils
-- | Parameters used to create lua packages/modules.
data LuaPackageParams = LuaPackageParams
@@ -72,10 +74,11 @@ pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults
pandocPackageSearcher luaPkgParams pkgName =
case pkgName of
"pandoc" -> let datadir = luaPkgDataDir luaPkgParams
- in pushWrappedHsFun (pushPandocModule datadir)
+ in pushWrappedHsFun (Pandoc.pushModule datadir)
"pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams
mbRef = luaPkgMediaBag luaPkgParams
- in pushWrappedHsFun (pushMediaBagModule st mbRef)
+ in pushWrappedHsFun (MediaBag.pushModule st mbRef)
+ "pandoc.utils" -> pushWrappedHsFun Utils.pushModule
_ -> searchPureLuaLoader
where
pushWrappedHsFun f = do
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 5803e62dc..e688ad255 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -32,9 +32,12 @@ module Text.Pandoc.Lua.Util
( adjustIndexBy
, getTable
, addValue
+ , addFunction
, getRawInt
, setRawInt
, addRawInt
+ , raiseError
+ , OrNil (..)
, PushViaCall
, pushViaCall
, pushViaConstructor
@@ -44,8 +47,8 @@ module Text.Pandoc.Lua.Util
import Control.Monad (when)
import Data.ByteString.Char8 (unpack)
-import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex,
- ToLuaStack (..), getglobal')
+import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex,
+ ToLuaStack (..), ToHaskellFunction, getglobal')
import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti)
import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
@@ -66,13 +69,21 @@ getTable idx key = do
rawget (idx `adjustIndexBy` 1)
peek (-1) <* pop 1
--- | Add a key-value pair to the table at the top of the stack
+-- | Add a key-value pair to the table at the top of the stack.
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
addValue key value = do
push key
push value
rawset (-3)
+-- | Add a function to the table at the top of the stack, using the given name.
+addFunction :: ToHaskellFunction a => String -> a -> Lua ()
+addFunction name fn = do
+ Lua.push name
+ Lua.pushHaskellFunction fn
+ Lua.wrapHaskellFunction
+ Lua.rawset (-3)
+
-- | Get value behind key from table at given index.
getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
getRawInt idx key =
@@ -90,6 +101,22 @@ setRawInt idx key value = do
addRawInt :: ToLuaStack a => Int -> a -> Lua ()
addRawInt = setRawInt (-1)
+raiseError :: ToLuaStack a => a -> Lua NumResults
+raiseError e = do
+ Lua.push e
+ fromIntegral <$> Lua.lerror
+
+-- | Newtype wrapper intended to be used for optional Lua values. Nesting this
+-- type is strongly discouraged and will likely lead to a wrong result.
+newtype OrNil a = OrNil { toMaybe :: Maybe a }
+
+instance FromLuaStack a => FromLuaStack (OrNil a) where
+ peek idx = do
+ noValue <- Lua.isnoneornil idx
+ if noValue
+ then return (OrNil Nothing)
+ else OrNil . Just <$> Lua.peek idx
+
-- | Helper class for pushing a single value to the stack via a lua function.
-- See @pushViaCall@.
class PushViaCall a where
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 13:42:47 +0000