diff --git a/pandoc.cabal b/pandoc.cabal
index ba54dee31..ba36f0230 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -480,9 +480,9 @@ library
file-embed >= 0.0 && < 0.1,
filepath >= 1.1 && < 1.5,
haddock-library >= 1.10 && < 1.11,
- hslua >= 2.0.1 && < 2.1,
- hslua-aeson >= 2.0.1 && < 2.1,
- hslua-marshalling >= 2.0.1 && < 2.1,
+ hslua >= 2.1 && < 2.2,
+ hslua-aeson >= 2.1 && < 2.2,
+ hslua-marshalling >= 2.1 && < 2.2,
hslua-module-path >= 1.0 && < 1.1,
hslua-module-system >= 1.0 && < 1.1,
hslua-module-text >= 1.0 && < 1.1,
@@ -724,7 +724,6 @@ library
Text.Pandoc.Lua.Orphans,
Text.Pandoc.Lua.Packages,
Text.Pandoc.Lua.PandocLua,
- Text.Pandoc.Lua.Util,
Text.Pandoc.XML.Light,
Text.Pandoc.XML.Light.Types,
Text.Pandoc.XML.Light.Proc,
@@ -782,7 +781,7 @@ test-suite test-pandoc
doctemplates >= 0.10 && < 0.11,
exceptions >= 0.8 && < 0.11,
filepath >= 1.1 && < 1.5,
- hslua >= 2.0 && < 2.1,
+ hslua >= 2.1 && < 2.2,
mtl >= 2.2 && < 2.3,
pandoc-types >= 1.22.1 && < 1.23,
process >= 1.2.3 && < 1.7,
diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs
index 232061514..2083f99dd 100644
--- a/src/Text/Pandoc/Lua/ErrorConversion.hs
+++ b/src/Text/Pandoc/Lua/ErrorConversion.hs
@@ -1,5 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE LambdaCase #-}
{- |
Module : Text.Pandoc.Lua.ErrorConversion
Copyright : © 2020-2022 Albert Krewinkel
@@ -17,7 +16,6 @@ module Text.Pandoc.Lua.ErrorConversion
import HsLua (LuaError, LuaE, top)
import HsLua.Marshalling (resultToEither, runPeek)
-import HsLua.Class.Peekable (PeekError (..))
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError)
@@ -41,8 +39,3 @@ instance LuaError PandocError where
popException = popPandocError
pushException = pushPandocError
luaException = PandocLuaError . T.pack
-
-instance PeekError PandocError where
- messageFromException = \case
- PandocLuaError m -> T.unpack m
- err -> show err
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index 9796c4baa..da8af9a26 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -23,13 +23,12 @@ import Text.Pandoc.Lua.ErrorConversion ()
import Text.Pandoc.Lua.Marshal.AST
import Text.Pandoc.Lua.Marshal.Filter
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-- | Transform document using the filter defined in the given file.
runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc
runFilterFile filterPath doc = do
oldtop <- gettop
- stat <- LuaUtil.dofileWithTraceback filterPath
+ stat <- dofileTrace filterPath
if stat /= Lua.OK
then throwErrorAsException
else do
diff --git a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs
index 51bd38356..1b3acc076 100644
--- a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs
+++ b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs
@@ -21,8 +21,8 @@ module Text.Pandoc.Lua.Marshal.ReaderOptions
import Data.Default (def)
import HsLua as Lua
+import HsLua.Aeson (peekViaJSON, pushViaJSON)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
-import Text.Pandoc.Lua.Util (peekViaJSON, pushViaJSON)
import Text.Pandoc.Options (ReaderOptions (..))
--
diff --git a/src/Text/Pandoc/Lua/Marshal/Reference.hs b/src/Text/Pandoc/Lua/Marshal/Reference.hs
index d7b9fdf5c..3bbc4082c 100644
--- a/src/Text/Pandoc/Lua/Marshal/Reference.hs
+++ b/src/Text/Pandoc/Lua/Marshal/Reference.hs
@@ -28,7 +28,6 @@ import Text.Pandoc.Lua.Marshal.Inline (pushInlines)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import qualified Data.Map as Map
-import qualified HsLua
-- | Pushes a ReaderOptions value as userdata object.
pushReference :: LuaError e => Pusher e (Reference Inlines)
@@ -94,14 +93,3 @@ pushDate = pushAsTable
where
-- date parts are lists of Int values
pushDateParts (DateParts dp) = pushPandocList pushIntegral dp
-
--- | Helper funtion to push an object as a table.
-pushAsTable :: LuaError e
- => [(HsLua.Name, a -> LuaE e ())]
- -> a -> LuaE e ()
-pushAsTable props obj = do
- createtable 0 (length props)
- forM_ props $ \(name, pushValue) -> do
- HsLua.pushName name
- pushValue obj
- rawset (nth 3)
diff --git a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
index a04e0bd94..639b85422 100644
--- a/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
+++ b/src/Text/Pandoc/Lua/Marshal/WriterOptions.hs
@@ -20,9 +20,9 @@ module Text.Pandoc.Lua.Marshal.WriterOptions
import Control.Applicative (optional)
import Data.Default (def)
import HsLua as Lua
+import HsLua.Aeson (peekViaJSON, pushViaJSON)
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Marshal.Template (peekTemplate, pushTemplate)
-import Text.Pandoc.Lua.Util (peekViaJSON, pushViaJSON)
import Text.Pandoc.Options (WriterOptions (..))
--
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 51d813517..8be668089 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -16,7 +16,7 @@ import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)
import HsLua ( LuaE, DocumentedFunction, Module (..)
, (<#>), (###), (=#>), (=?>), defun, functionResult
- , optionalParameter , parameter)
+ , opt, parameter, stringParam, textParam)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
setMediaBag)
@@ -55,7 +55,7 @@ delete :: DocumentedFunction PandocError
delete = defun "delete"
### (\fp -> unPandocLua $ modifyCommonState
(\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }))
- <#> parameter Lua.peekString "string" "filepath" "filename of item to delete"
+ <#> stringParam "filepath" "filename of item to delete"
=#> []
@@ -72,10 +72,10 @@ insert = defun "insert"
mb <- getMediaBag
setMediaBag $ MB.insertMedia fp mmime contents mb
return (Lua.NumResults 0))
- <#> parameter Lua.peekString "string" "filepath" "item file path"
- <#> optionalParameter Lua.peekText "string" "mimetype" "the item's MIME type"
+ <#> stringParam "filepath" "item file path"
+ <#> opt (textParam "mimetype" "the item's MIME type")
<#> parameter Lua.peekLazyByteString "string" "contents" "binary contents"
- =?> "Nothing"
+ =#> []
-- | Returns iterator values to be used with a Lua @for@ loop.
items :: DocumentedFunction PandocError
@@ -98,7 +98,7 @@ lookup = defun "lookup"
Just item -> 2 <$ do
Lua.pushText $ MB.mediaMimeType item
Lua.pushLazyByteString $ MB.mediaContents item)
- <#> parameter Lua.peekString "string" "filepath" "path of item to lookup"
+ <#> stringParam "filepath" "path of item to lookup"
=?> "MIME type and contents"
-- | Function listing all mediabag items.
@@ -122,5 +122,5 @@ fetch = defun "fetch"
Lua.pushText $ fromMaybe "" mimeType
Lua.pushByteString bs
return 2)
- <#> parameter Lua.peekText "string" "src" "URI to fetch"
+ <#> textParam "src" "URI to fetch"
=?> "Returns two string values: the fetched contents and the mimetype."
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index 9864da0db..7d8a98bb1 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -26,7 +26,6 @@ import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (Proxy))
import HsLua hiding (pushModule)
-import HsLua.Class.Peekable (PeekError)
import System.Exit (ExitCode (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError (..))
@@ -49,7 +48,6 @@ import qualified HsLua as Lua
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
-import qualified Text.Pandoc.Lua.Util as LuaUtil
import qualified Text.Pandoc.UTF8 as UTF8
-- | Push the "pandoc" package to the Lua stack. Requires the `List`
@@ -198,9 +196,9 @@ functions =
Left e ->
throwM e)
<#> parameter peekByteString "string" "content" "text to parse"
- <#> optionalParameter peekText "string" "formatspec" "format and extensions"
- <#> optionalParameter peekReaderOptions "ReaderOptions" "reader_options"
- "reader options"
+ <#> opt (textParam "formatspec" "format and extensions")
+ <#> opt (parameter peekReaderOptions "ReaderOptions" "reader_options"
+ "reader options")
=#> functionResult pushPandoc "Pandoc" "result document"
, sha1
@@ -227,10 +225,9 @@ functions =
(ByteStringWriter w, es) -> Left <$>
w writerOpts{ writerExtensions = es } doc)
<#> parameter peekPandoc "Pandoc" "doc" "document to convert"
- <#> optionalParameter peekText "string" "formatspec"
- "format and extensions"
- <#> optionalParameter peekWriterOptions "WriterOptions" "writer_options"
- "writer options"
+ <#> opt (textParam "formatspec" "format and extensions")
+ <#> opt (parameter peekWriterOptions "WriterOptions" "writer_options"
+ "writer options")
=#> functionResult (either pushLazyByteString pushText) "string"
"result document"
]
@@ -247,23 +244,23 @@ data PipeError = PipeError
, pipeErrorOutput :: BL.ByteString
}
-peekPipeError :: PeekError e => StackIndex -> LuaE e PipeError
+peekPipeError :: LuaError e => StackIndex -> LuaE e PipeError
peekPipeError 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)
-pushPipeError :: PeekError e => Pusher e PipeError
+pushPipeError :: LuaError e => Pusher e PipeError
pushPipeError pipeErr = do
- Lua.newtable
- LuaUtil.addField "command" (pipeErrorCommand pipeErr)
- LuaUtil.addField "error_code" (pipeErrorCode pipeErr)
- LuaUtil.addField "output" (pipeErrorOutput pipeErr)
+ pushAsTable [ ("command" , pushText . pipeErrorCommand)
+ , ("error_code" , pushIntegral . pipeErrorCode)
+ , ("output" , pushLazyByteString . pipeErrorOutput)
+ ] pipeErr
pushPipeErrorMetaTable
- Lua.setmetatable (-2)
+ Lua.setmetatable (nth 2)
where
- pushPipeErrorMetaTable :: PeekError e => LuaE e ()
+ pushPipeErrorMetaTable :: LuaError e => LuaE e ()
pushPipeErrorMetaTable = do
v <- Lua.newmetatable "pandoc pipe error"
when v $ do
@@ -271,7 +268,7 @@ pushPipeError pipeErr = do
pushHaskellFunction pipeErrorMessage
rawset (nth 3)
- pipeErrorMessage :: PeekError e => LuaE e NumResults
+ pipeErrorMessage :: LuaError e => LuaE e NumResults
pipeErrorMessage = do
(PipeError cmd errorCode output) <- peekPipeError (nthBottom 1)
pushByteString . BSL.toStrict . BSL.concat $
diff --git a/src/Text/Pandoc/Lua/Module/Template.hs b/src/Text/Pandoc/Lua/Module/Template.hs
index cd66ce1c1..967fe31a8 100644
--- a/src/Text/Pandoc/Lua/Module/Template.hs
+++ b/src/Text/Pandoc/Lua/Module/Template.hs
@@ -42,7 +42,7 @@ functions =
Nothing -> runWithDefaultPartials
(compileTemplate "templates/default" template))
<#> parameter peekText "string" "template" "template string"
- <#> optionalParameter peekString "string" "templ_path" "template path"
+ <#> opt (stringParam "templ_path" "template path")
=#> functionResult (either failLua pushTemplate) "pandoc Template"
"compiled template"
@@ -53,8 +53,8 @@ functions =
forcePeek $ peekText top `lastly` pop 1
format <- maybe getFORMAT pure mformat
getDefaultTemplate format)
- <#> optionalParameter peekText "string" "writer"
- "writer for which the template should be returned."
+ <#> opt (textParam "writer"
+ "writer for which the template should be returned.")
=#> functionResult pushText "string"
"string representation of the writer's default template"
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 0c3969e13..14796b146 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -56,8 +56,7 @@ documentedModule = Module
return $ B.toList (Shared.blocksToInlinesWithSep sep blks))
<#> parameter (peekList peekBlock) "list of blocks"
"blocks" ""
- <#> optionalParameter (peekList peekInline) "list of inlines"
- "inline" ""
+ <#> opt (parameter (peekList peekInline) "list of inlines" "inline" "")
=#> functionResult pushInlines "list of inlines" ""
, defun "equals"
@@ -121,8 +120,8 @@ documentedModule = Module
)
<#> parameter peekPandoc "Pandoc" "doc" "input document"
<#> parameter peekString "filepath" "filter_path" "path to filter"
- <#> optionalParameter (peekList peekString) "list of strings"
- "args" "arguments to pass to the filter"
+ <#> opt (parameter (peekList peekString) "list of strings"
+ "args" "arguments to pass to the filter")
=#> functionResult pushPandoc "Pandoc" "filtered document"
, defun "stringify"
diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs
index c8a83fea4..62b54d051 100644
--- a/src/Text/Pandoc/Lua/Orphans.hs
+++ b/src/Text/Pandoc/Lua/Orphans.hs
@@ -65,9 +65,6 @@ instance Pushable QuoteType where
instance Pushable Cell where
push = pushCell
-instance Peekable Cell where
- peek = forcePeek . peekCell
-
instance Pushable Inline where
push = pushInline
@@ -92,25 +89,28 @@ instance Pushable TableHead where
-- These instances exist only for testing. It's a hack to avoid making
-- the marshalling modules public.
instance Peekable Inline where
- peek = forcePeek . peekInline
+ safepeek = peekInline
instance Peekable Block where
- peek = forcePeek . peekBlock
+ safepeek = peekBlock
+
+instance Peekable Cell where
+ safepeek = peekCell
instance Peekable Meta where
- peek = forcePeek . peekMeta
+ safepeek = peekMeta
instance Peekable Pandoc where
- peek = forcePeek . peekPandoc
+ safepeek = peekPandoc
instance Peekable Row where
- peek = forcePeek . peekRow
+ safepeek = peekRow
instance Peekable Version where
- peek = forcePeek . peekVersionFuzzy
+ safepeek = peekVersionFuzzy
instance {-# OVERLAPPING #-} Peekable Attr where
- peek = forcePeek . peekAttr
+ safepeek = peekAttr
instance Pushable Sources where
push = pushSources
diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs
index bc5085fdb..52ace5f6b 100644
--- a/src/Text/Pandoc/Lua/PandocLua.hs
+++ b/src/Text/Pandoc/Lua/PandocLua.hs
@@ -68,10 +68,10 @@ runPandocLua pLua = do
return result
instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where
- partialApply _narg = unPandocLua
+ partialApply _narg = liftLua . unPandocLua
instance Pushable a => Exposable PandocError (PandocLua a) where
- partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push)
+ partialApply _narg x = 1 <$ (liftLua (unPandocLua x >>= Lua.push))
-- | Global variables which should always be set.
defaultGlobals :: PandocMonad m => m [Global]
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
deleted file mode 100644
index 324a1a8e8..000000000
--- a/src/Text/Pandoc/Lua/Util.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{- |
- Module : Text.Pandoc.Lua.Util
- Copyright : © 2012-2022 John MacFarlane,
- © 2017-2022 Albert Krewinkel
- License : GNU GPL, version 2 or above
-
- Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
- Stability : alpha
-
-Lua utility functions.
--}
-module Text.Pandoc.Lua.Util
- ( addField
- , callWithTraceback
- , pcallWithTraceback
- , dofileWithTraceback
- , peekViaJSON
- , pushViaJSON
- ) where
-
-import Control.Monad (when)
-import HsLua
-import HsLua.Aeson (peekValue, pushValue)
-import qualified Data.Aeson as Aeson
-import qualified HsLua as Lua
-import qualified Text.Pandoc.UTF8 as UTF8
-
--- | Add a value to the table at the top of the stack at a string-index.
-addField :: (LuaError e, Pushable a) => String -> a -> LuaE e ()
-addField key value = do
- Lua.push key
- Lua.push value
- Lua.rawset (Lua.nth 3)
-
--- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
--- traceback on error.
-pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status
-pcallWithTraceback nargs nresults = do
- let traceback' :: LuaError e => LuaE e NumResults
- traceback' = do
- l <- Lua.state
- msg <- Lua.tostring' (Lua.nthBottom 1)
- Lua.traceback l (Just msg) 2
- return 1
- tracebackIdx <- Lua.absindex (Lua.nth (Lua.fromNumArgs nargs + 1))
- Lua.pushHaskellFunction traceback'
- Lua.insert tracebackIdx
- result <- Lua.pcall nargs nresults (Just tracebackIdx)
- Lua.remove tracebackIdx
- return result
-
--- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
-callWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e ()
-callWithTraceback nargs nresults = do
- result <- pcallWithTraceback nargs nresults
- when (result /= Lua.OK)
- Lua.throwErrorAsException
-
--- | Run the given string as a Lua program, while also adding a traceback to the
--- error message if an error occurs.
-dofileWithTraceback :: LuaError e => FilePath -> LuaE e Status
-dofileWithTraceback fp = do
- loadRes <- Lua.loadfile fp
- case loadRes of
- Lua.OK -> pcallWithTraceback 0 Lua.multret
- _ -> return loadRes
-
-
--- These will become part of hslua-aeson in future versions.
-
--- | Retrieves a value from the Lua stack via JSON.
-peekViaJSON :: (Aeson.FromJSON a, LuaError e) => Peeker e a
-peekViaJSON idx = do
- value <- peekValue idx
- case Aeson.fromJSON value of
- Aeson.Success x -> pure x
- Aeson.Error msg -> failPeek $ "failed to decode: " <>
- UTF8.fromString msg
-
--- | Pushes a value to the Lua stack as a JSON-like value.
-pushViaJSON :: (Aeson.ToJSON a, LuaError e) => Pusher e a
-pushViaJSON = pushValue . Aeson.toJSON
diff --git a/src/Text/Pandoc/Readers/Custom.hs b/src/Text/Pandoc/Readers/Custom.hs
index 031beb679..195ad6cf4 100644
--- a/src/Text/Pandoc/Readers/Custom.hs
+++ b/src/Text/Pandoc/Readers/Custom.hs
@@ -14,7 +14,7 @@ Supports custom parsers written in Lua which produce a Pandoc AST.
module Text.Pandoc.Readers.Custom ( readCustom ) where
import Control.Exception
import Control.Monad (when)
-import HsLua as Lua hiding (Operation (Div), render)
+import HsLua as Lua hiding (Operation (Div))
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Definition
import Text.Pandoc.Class (PandocMonad, report)
@@ -22,8 +22,6 @@ import Text.Pandoc.Logging
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.PandocLua
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
-import Text.Pandoc.Lua.Util (dofileWithTraceback, callWithTraceback,
- pcallWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
import qualified Data.Text as T
@@ -35,7 +33,7 @@ readCustom luaFile opts srcs = do
let globals = [ PANDOC_SCRIPT_FILE luaFile ]
res <- runLua $ do
setGlobals globals
- stat <- dofileWithTraceback luaFile
+ stat <- dofileTrace luaFile
-- check for error in lua script (later we'll change the return type
-- to handle this more gracefully):
when (stat /= Lua.OK)
@@ -50,7 +48,7 @@ readCustom luaFile opts srcs = do
getglobal "Reader"
push input
push opts
- pcallWithTraceback 2 1 >>= \case
+ pcallTrace 2 1 >>= \case
OK -> forcePeek $ peekPandoc top
ErrRun -> do
-- Caught a runtime error. Check if parsing might work if we
@@ -74,7 +72,7 @@ readCustom luaFile opts srcs = do
getglobal "Reader"
push $ sourcesToText input -- push sources as string
push opts
- callWithTraceback 2 1
+ callTrace 2 1
forcePeek $ peekPandoc top
else
-- nothing we can do here
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 6ad36468a..70c03a016 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -25,14 +25,13 @@ import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text (Text, pack)
-import HsLua as Lua hiding (Operation (Div), render)
-import HsLua.Class.Peekable (PeekError)
+import HsLua as Lua hiding (Operation (Div))
+import HsLua.Aeson (peekViaJSON)
import Text.DocLayout (render, literal)
import Text.DocTemplates (Context)
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Definition
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
-import Text.Pandoc.Lua.Util (addField, dofileWithTraceback, peekViaJSON)
import Text.Pandoc.Options
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Templates (renderTemplate)
@@ -44,36 +43,34 @@ attrToMap (id',classes,keyvals) = M.fromList
: ("class", T.unwords classes)
: keyvals
-newtype Stringify e a = Stringify a
+newtype Stringify a = Stringify a
-instance Pushable (Stringify e Format) where
+instance Pushable (Stringify Format) where
push (Stringify (Format f)) = Lua.push (T.toLower f)
-instance PeekError e => Pushable (Stringify e [Inline]) where
- push (Stringify ils) = Lua.push =<<
- changeErrorType ((inlineListToCustom @e) ils)
+instance Pushable (Stringify [Inline]) where
+ push (Stringify ils) = Lua.push =<< inlineListToCustom ils
-instance PeekError e => Pushable (Stringify e [Block]) where
- push (Stringify blks) = Lua.push =<<
- changeErrorType ((blockListToCustom @e) blks)
+instance Pushable (Stringify [Block]) where
+ push (Stringify blks) = Lua.push =<< blockListToCustom blks
-instance PeekError e => Pushable (Stringify e MetaValue) where
- push (Stringify (MetaMap m)) = Lua.push (fmap (Stringify @e) m)
- push (Stringify (MetaList xs)) = Lua.push (map (Stringify @e) xs)
+instance Pushable (Stringify MetaValue) where
+ push (Stringify (MetaMap m)) = Lua.push (fmap Stringify m)
+ push (Stringify (MetaList xs)) = Lua.push (map Stringify xs)
push (Stringify (MetaBool x)) = Lua.push x
push (Stringify (MetaString s)) = Lua.push s
- push (Stringify (MetaInlines ils)) = Lua.push (Stringify @e ils)
- push (Stringify (MetaBlocks bs)) = Lua.push (Stringify @e bs)
+ push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils)
+ push (Stringify (MetaBlocks bs)) = Lua.push (Stringify bs)
-instance PeekError e => Pushable (Stringify e Citation) where
- push (Stringify cit) = do
- Lua.createtable 6 0
- addField "citationId" $ citationId cit
- addField "citationPrefix" . Stringify @e $ citationPrefix cit
- addField "citationSuffix" . Stringify @e $ citationSuffix cit
- addField "citationMode" $ show (citationMode cit)
- addField "citationNoteNum" $ citationNoteNum cit
- addField "citationHash" $ citationHash cit
+instance Pushable (Stringify Citation) where
+ push (Stringify cit) = flip pushAsTable cit
+ [ ("citationId", push . citationId)
+ , ("citationPrefix", push . Stringify . citationPrefix)
+ , ("citationSuffix", push . Stringify . citationSuffix)
+ , ("citationMode", push . citationMode)
+ , ("citationNoteNum", push . citationNoteNum)
+ , ("citationHash", push . citationHash)
+ ]
-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
-- associated value.
@@ -96,7 +93,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
]
res <- runLua $ do
setGlobals globals
- stat <- dofileWithTraceback luaFile
+ stat <- dofileTrace luaFile
-- check for error in lua script (later we'll change the return type
-- to handle this more gracefully):
when (stat /= Lua.OK)
@@ -115,7 +112,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
Just tpl -> render Nothing $
renderTemplate tpl $ setField "body" body context
-docToCustom :: forall e. PeekError e
+docToCustom :: forall e. LuaError e
=> WriterOptions -> Pandoc -> LuaE e (String, Context Text)
docToCustom opts (Pandoc (Meta metamap) blocks) = do
body <- blockListToCustom blocks
@@ -123,7 +120,7 @@ docToCustom opts (Pandoc (Meta metamap) blocks) = do
-- `Doc` manually.
Lua.getglobal "Doc" -- function
push body -- argument 1
- push (fmap (Stringify @e) metamap) -- argument 2
+ push (fmap Stringify metamap) -- argument 2
push (writerVariables opts) -- argument 3
call 3 2
rendered <- peek (nth 2) -- first return value
@@ -131,125 +128,125 @@ docToCustom opts (Pandoc (Meta metamap) blocks) = do
return (rendered, fromMaybe mempty context)
-- | Convert Pandoc block element to Custom.
-blockToCustom :: forall e. PeekError e
+blockToCustom :: forall e. LuaError e
=> Block -- ^ Block element
-> LuaE e String
blockToCustom Null = return ""
-blockToCustom (Plain inlines) = invoke @e "Plain" (Stringify @e inlines)
+blockToCustom (Plain inlines) = invoke "Plain" (Stringify inlines)
blockToCustom (Para [Image attr txt (src,tit)]) =
- invoke @e "CaptionedImage" src tit (Stringify @e txt) (attrToMap attr)
+ invoke "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
-blockToCustom (Para inlines) = invoke @e "Para" (Stringify @e inlines)
+blockToCustom (Para inlines) = invoke "Para" (Stringify inlines)
blockToCustom (LineBlock linesList) =
- invoke @e "LineBlock" (map (Stringify @e) linesList)
+ invoke "LineBlock" (map (Stringify) linesList)
blockToCustom (RawBlock format str) =
- invoke @e "RawBlock" (Stringify @e format) str
+ invoke "RawBlock" (Stringify format) str
-blockToCustom HorizontalRule = invoke @e "HorizontalRule"
+blockToCustom HorizontalRule = invoke "HorizontalRule"
blockToCustom (Header level attr inlines) =
- invoke @e "Header" level (Stringify @e inlines) (attrToMap attr)
+ invoke "Header" level (Stringify inlines) (attrToMap attr)
blockToCustom (CodeBlock attr str) =
- invoke @e "CodeBlock" str (attrToMap attr)
+ invoke "CodeBlock" str (attrToMap attr)
blockToCustom (BlockQuote blocks) =
- invoke @e "BlockQuote" (Stringify @e blocks)
+ invoke "BlockQuote" (Stringify blocks)
blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
aligns' = map show aligns
- capt' = Stringify @e capt
- headers' = map (Stringify @e) headers
- rows' = map (map (Stringify @e)) rows
- in invoke @e "Table" capt' aligns' widths headers' rows'
+ capt' = Stringify capt
+ headers' = map (Stringify) headers
+ rows' = map (map (Stringify)) rows
+ in invoke "Table" capt' aligns' widths headers' rows'
blockToCustom (BulletList items) =
- invoke @e "BulletList" (map (Stringify @e) items)
+ invoke "BulletList" (map (Stringify) items)
blockToCustom (OrderedList (num,sty,delim) items) =
- invoke @e "OrderedList" (map (Stringify @e) items) num (show sty) (show delim)
+ invoke "OrderedList" (map (Stringify) items) num (show sty) (show delim)
blockToCustom (DefinitionList items) =
- invoke @e "DefinitionList"
- (map (KeyValue . (Stringify @e *** map (Stringify @e))) items)
+ invoke "DefinitionList"
+ (map (KeyValue . (Stringify *** map (Stringify))) items)
blockToCustom (Div attr items) =
- invoke @e "Div" (Stringify @e items) (attrToMap attr)
+ invoke "Div" (Stringify items) (attrToMap attr)
-- | Convert list of Pandoc block elements to Custom.
-blockListToCustom :: forall e. PeekError e
+blockListToCustom :: forall e. LuaError e
=> [Block] -- ^ List of block elements
-> LuaE e String
blockListToCustom xs = do
- blocksep <- invoke @e "Blocksep"
+ blocksep <- invoke "Blocksep"
bs <- mapM blockToCustom xs
return $ mconcat $ intersperse blocksep bs
-- | Convert list of Pandoc inline elements to Custom.
-inlineListToCustom :: forall e. PeekError e => [Inline] -> LuaE e String
+inlineListToCustom :: forall e. LuaError e => [Inline] -> LuaE e String
inlineListToCustom lst = do
xs <- mapM (inlineToCustom @e) lst
return $ mconcat xs
-- | Convert Pandoc inline element to Custom.
-inlineToCustom :: forall e. PeekError e => Inline -> LuaE e String
+inlineToCustom :: forall e. LuaError e => Inline -> LuaE e String
-inlineToCustom (Str str) = invoke @e "Str" str
+inlineToCustom (Str str) = invoke "Str" str
-inlineToCustom Space = invoke @e "Space"
+inlineToCustom Space = invoke "Space"
-inlineToCustom SoftBreak = invoke @e "SoftBreak"
+inlineToCustom SoftBreak = invoke "SoftBreak"
-inlineToCustom (Emph lst) = invoke @e "Emph" (Stringify @e lst)
+inlineToCustom (Emph lst) = invoke "Emph" (Stringify lst)
-inlineToCustom (Underline lst) = invoke @e "Underline" (Stringify @e lst)
+inlineToCustom (Underline lst) = invoke "Underline" (Stringify lst)
-inlineToCustom (Strong lst) = invoke @e "Strong" (Stringify @e lst)
+inlineToCustom (Strong lst) = invoke "Strong" (Stringify lst)
-inlineToCustom (Strikeout lst) = invoke @e "Strikeout" (Stringify @e lst)
+inlineToCustom (Strikeout lst) = invoke "Strikeout" (Stringify lst)
-inlineToCustom (Superscript lst) = invoke @e "Superscript" (Stringify @e lst)
+inlineToCustom (Superscript lst) = invoke "Superscript" (Stringify lst)
-inlineToCustom (Subscript lst) = invoke @e "Subscript" (Stringify @e lst)
+inlineToCustom (Subscript lst) = invoke "Subscript" (Stringify lst)
-inlineToCustom (SmallCaps lst) = invoke @e "SmallCaps" (Stringify @e lst)
+inlineToCustom (SmallCaps lst) = invoke "SmallCaps" (Stringify lst)
inlineToCustom (Quoted SingleQuote lst) =
- invoke @e "SingleQuoted" (Stringify @e lst)
+ invoke "SingleQuoted" (Stringify lst)
inlineToCustom (Quoted DoubleQuote lst) =
- invoke @e "DoubleQuoted" (Stringify @e lst)
+ invoke "DoubleQuoted" (Stringify lst)
inlineToCustom (Cite cs lst) =
- invoke @e "Cite" (Stringify @e lst) (map (Stringify @e) cs)
+ invoke "Cite" (Stringify lst) (map (Stringify) cs)
inlineToCustom (Code attr str) =
- invoke @e "Code" str (attrToMap attr)
+ invoke "Code" str (attrToMap attr)
inlineToCustom (Math DisplayMath str) =
- invoke @e "DisplayMath" str
+ invoke "DisplayMath" str
inlineToCustom (Math InlineMath str) =
- invoke @e "InlineMath" str
+ invoke "InlineMath" str
inlineToCustom (RawInline format str) =
- invoke @e "RawInline" (Stringify @e format) str
+ invoke "RawInline" (Stringify format) str
-inlineToCustom LineBreak = invoke @e "LineBreak"
+inlineToCustom LineBreak = invoke "LineBreak"
inlineToCustom (Link attr txt (src,tit)) =
- invoke @e "Link" (Stringify @e txt) src tit (attrToMap attr)
+ invoke "Link" (Stringify txt) src tit (attrToMap attr)
inlineToCustom (Image attr alt (src,tit)) =
- invoke @e "Image" (Stringify @e alt) src tit (attrToMap attr)
+ invoke "Image" (Stringify alt) src tit (attrToMap attr)
-inlineToCustom (Note contents) = invoke @e "Note" (Stringify @e contents)
+inlineToCustom (Note contents) = invoke "Note" (Stringify contents)
inlineToCustom (Span attr items) =
- invoke @e "Span" (Stringify @e items) (attrToMap attr)
+ invoke "Span" (Stringify items) (attrToMap attr)
diff --git a/stack.yaml b/stack.yaml
index be6c81247..0286130ac 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -12,22 +12,23 @@ extra-deps:
- doctemplates-0.10.0.1
- emojis-0.1.2
- doclayout-0.3.1.1
-- lpeg-1.0.1
-- hslua-2.0.1
-- hslua-aeson-2.0.1
-- hslua-classes-2.0.0
-- hslua-core-2.0.0.2
-- hslua-marshalling-2.0.1
-- hslua-module-path-1.0.0
-- hslua-module-system-1.0.0
-- hslua-module-text-1.0.0
-- hslua-module-version-1.0.0
-- hslua-objectorientation-2.0.1
-- hslua-packaging-2.0.0
-- lua-2.0.2
-- tasty-hslua-1.0.0
-- tasty-lua-1.0.0
-- pandoc-lua-marshal-0.1.3.1
+- lpeg-1.0.2
+- hslua-2.1.0
+- hslua-aeson-2.1.0
+- hslua-classes-2.1.0
+- hslua-core-2.1.0
+- hslua-marshalling-2.1.0
+- hslua-module-path-1.0.1
+- hslua-module-system-1.0.1
+- hslua-module-text-1.0.1
+- hslua-module-version-1.0.1
+- hslua-objectorientation-2.1.0
+- hslua-packaging-2.1.0
+- lua-2.1.0
+- lua-arbitrary-1.0.0
+- tasty-hslua-1.0.1
+- tasty-lua-1.0.1
+- pandoc-lua-marshal-0.1.4
- pandoc-types-1.22.1
- aeson-pretty-0.8.9
- unicode-transforms-0.4.0
@@ -43,5 +44,3 @@ ghc-options:
resolver: lts-18.10
nix:
packages: [zlib]
-
-