Switch to hslua-2.1
This allows for some code simplification and improves stability.
This commit is contained in:
Albert Krewinkel
John MacFarlane
parent
a6fa3df114
commit
412596c30b
16 changed files with 138 additions and 252 deletions
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 (..))
|
||||
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 (..))
|
||||
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
35
stack.yaml
35
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]
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue