From 9e74826ba9ce4139bfdd3f057a79efa8b644e85a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 20 Oct 2021 21:40:07 +0200 Subject: Switch to hslua-2.0 The new HsLua version takes a somewhat different approach to marshalling and unmarshalling, relying less on typeclasses and more on specialized types. This allows for better performance and improved error messages. Furthermore, new abstractions allow to document the code and exposed functions. --- src/Text/Pandoc/Lua/Module/Utils.hs | 227 ++++++++++++++++++++++-------------- 1 file changed, 140 insertions(+), 87 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 3ec3afc26..8b6e31b43 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Module.Utils Copyright : Copyright © 2017-2021 Albert Krewinkel @@ -15,82 +17,137 @@ module Text.Pandoc.Lua.Module.Utils ) where import Control.Applicative ((<|>)) -import Control.Monad.Catch (try) +import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Default (def) import Data.Version (Version) -import Foreign.Lua (Peekable, Lua, NumResults (..)) +import HsLua as Lua hiding (pushModule) +import HsLua.Class.Peekable (PeekError) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () +import Text.Pandoc.Lua.Marshaling.AST + ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushPandoc + , peekAttr, peekListAttributes, peekMeta, peekMetaValue) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..) - , pushSimpleTable - ) -import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua) + ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) +import Text.Pandoc.Lua.Marshaling.Version (peekVersionFuzzy, pushVersion) +import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T -import qualified Foreign.Lua as Lua +import qualified HsLua.Packaging as Lua import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Shared as Shared +import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.Writers.Shared as Shared -- | Push the "pandoc.utils" module to the Lua stack. -pushModule :: PandocLua NumResults -pushModule = do - liftPandocLua Lua.newtable - addFunction "blocks_to_inlines" blocksToInlines - addFunction "equals" equals - addFunction "from_simple_table" from_simple_table - addFunction "make_sections" makeSections - addFunction "normalize_date" normalizeDate - addFunction "run_json_filter" runJSONFilter - addFunction "sha1" sha1 - addFunction "stringify" stringify - addFunction "to_roman_numeral" toRomanNumeral - addFunction "to_simple_table" to_simple_table - addFunction "Version" (return :: Version -> Lua Version) - return 1 - --- | Squashes a list of blocks into inlines. -blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline] -blocksToInlines blks optSep = liftPandocLua $ do - let sep = maybe Shared.defaultBlocksSeparator B.fromList - $ Lua.fromOptional optSep - return $ B.toList (Shared.blocksToInlinesWithSep sep blks) - --- | Convert list of Pandoc blocks into sections using Divs. -makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block] -makeSections number baselevel = - return . Shared.makeSections number (Lua.fromOptional baselevel) - --- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We --- limit years to the range 1601-9999 (ISO 8601 accepts greater than --- or equal to 1583, but MS Word only accepts dates starting 1601). --- Returns nil instead of a string if the conversion failed. -normalizeDate :: T.Text -> Lua (Lua.Optional T.Text) -normalizeDate = return . Lua.Optional . Shared.normalizeDate - --- | Run a JSON filter on the given document. -runJSONFilter :: Pandoc - -> FilePath - -> Lua.Optional [String] - -> PandocLua Pandoc -runJSONFilter doc filterFile optArgs = do - args <- case Lua.fromOptional optArgs of - Just x -> return x - Nothing -> liftPandocLua $ do - Lua.getglobal "FORMAT" - (:[]) <$> Lua.popValue - JSONFilter.apply def args filterFile doc - --- | Calculate the hash of the given contents. -sha1 :: BSL.ByteString - -> Lua T.Text -sha1 = return . T.pack . SHA.showDigest . SHA.sha1 +pandocUtilsModule :: Module PandocError +pandocUtilsModule = Module + { moduleName = "pandoc.utils" + , moduleDescription = "pandoc utility functions" + , moduleFields = [] + , moduleOperations = [] + , moduleFunctions = + [ defun "blocks_to_inlines" + ### (\blks mSep -> do + let sep = maybe Shared.defaultBlocksSeparator B.fromList mSep + return $ B.toList (Shared.blocksToInlinesWithSep sep blks)) + <#> parameter (peekList peekBlock) "list of blocks" + "blocks" "" + <#> optionalParameter (peekList peekInline) "list of inlines" + "inline" "" + =#> functionResult (pushPandocList pushInline) "list of inlines" "" + + , defun "equals" + ### liftPure2 (==) + <#> parameter peekAstElement "AST element" "elem1" "" + <#> parameter peekAstElement "AST element" "elem2" "" + =#> functionResult pushBool "boolean" "true iff elem1 == elem2" + + , defun "make_sections" + ### liftPure3 Shared.makeSections + <#> parameter peekBool "boolean" "numbering" "add header numbers" + <#> parameter (\i -> (Nothing <$ peekNil i) <|> (Just <$!> peekIntegral i)) + "integer or nil" "baselevel" "" + <#> parameter (peekList peekBlock) "list of blocks" + "blocks" "document blocks to process" + =#> functionResult (pushPandocList pushBlock) "list of Blocks" + "processes blocks" + + , defun "normalize_date" + ### liftPure Shared.normalizeDate + <#> parameter peekText "string" "date" "the date string" + =#> functionResult (maybe pushnil pushText) "string or nil" + "normalized date, or nil if normalization failed." + #? T.unwords + [ "Parse a date and convert (if possible) to \"YYYY-MM-DD\" format. We" + , "limit years to the range 1601-9999 (ISO 8601 accepts greater than" + , "or equal to 1583, but MS Word only accepts dates starting 1601)." + , "Returns nil instead of a string if the conversion failed." + ] + + , defun "sha1" + ### liftPure (SHA.showDigest . SHA.sha1) + <#> parameter (fmap BSL.fromStrict . peekByteString) "string" + "input" "" + =#> functionResult pushString "string" "hexadecimal hash value" + #? "Compute the hash of the given string value." + + , defun "Version" + ### liftPure (id @Version) + <#> parameter peekVersionFuzzy + "version string, list of integers, or integer" + "v" "version description" + =#> functionResult pushVersion "Version" "new Version object" + #? "Creates a Version object." + + , defun "run_json_filter" + ### (\doc filterPath margs -> do + args <- case margs of + Just xs -> return xs + Nothing -> do + Lua.getglobal "FORMAT" + (forcePeek ((:[]) <$!> peekString top) <* pop 1) + JSONFilter.apply def args filterPath doc + ) + <#> 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" + =#> functionResult pushPandoc "Pandoc" "filtered document" + + , defun "stringify" + ### unPandocLua . stringify + <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" + =#> functionResult pushText "string" "stringified element" + + , defun "from_simple_table" + ### from_simple_table + <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" "" + =?> "Simple table" + + , defun "to_roman_numeral" + ### liftPure Shared.toRomanNumeral + <#> parameter (peekIntegral @Int) "integer" "n" "number smaller than 4000" + =#> functionResult pushText "string" "roman numeral" + #? "Converts a number < 4000 to uppercase roman numeral." + + , defun "to_simple_table" + ### to_simple_table + <#> parameter peekTable "Block" "tbl" "a table" + =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object" + #? "Converts a table into an old/simple table." + ] + } + +pushModule :: LuaE PandocError NumResults +pushModule = 1 <$ Lua.pushModule pandocUtilsModule + -- | Convert pandoc structure to a string with formatting removed. -- Footnotes are skipped (since we don't want their contents in link @@ -111,9 +168,6 @@ stringifyMetaValue mv = case mv of MetaString s -> s _ -> Shared.stringify mv -equals :: AstElement -> AstElement -> PandocLua Bool -equals e1 e2 = return (e1 == e2) - data AstElement = PandocElement Pandoc | MetaElement Meta @@ -125,22 +179,19 @@ data AstElement | CitationElement Citation deriving (Eq, Show) -instance Peekable AstElement where - peek idx = do - res <- try $ (PandocElement <$> Lua.peek idx) - <|> (InlineElement <$> Lua.peek idx) - <|> (BlockElement <$> Lua.peek idx) - <|> (AttrElement <$> Lua.peek idx) - <|> (ListAttributesElement <$> Lua.peek idx) - <|> (MetaElement <$> Lua.peek idx) - <|> (MetaValueElement <$> Lua.peek idx) - case res of - Right x -> return x - Left (_ :: PandocError) -> Lua.throwMessage - "Expected an AST element, but could not parse value as such." +peekAstElement :: PeekError e => Peeker e AstElement +peekAstElement = retrieving "pandoc AST element" . choice + [ (fmap PandocElement . peekPandoc) + , (fmap InlineElement . peekInline) + , (fmap BlockElement . peekBlock) + , (fmap AttrElement . peekAttr) + , (fmap ListAttributesElement . peekListAttributes) + , (fmap MetaElement . peekMeta) + , (fmap MetaValueElement . peekMetaValue) + ] -- | Converts an old/simple table into a normal table block element. -from_simple_table :: SimpleTable -> Lua NumResults +from_simple_table :: SimpleTable -> LuaE PandocError NumResults from_simple_table (SimpleTable capt aligns widths head' body) = do Lua.push $ Table nullAttr @@ -159,17 +210,19 @@ from_simple_table (SimpleTable capt aligns widths head' body) = do toColWidth w = ColWidth w -- | Converts a table into an old/simple table. -to_simple_table :: Block -> Lua NumResults +to_simple_table :: Block -> LuaE PandocError SimpleTable to_simple_table = \case Table _attr caption specs thead tbodies tfoot -> do let (capt, aligns, widths, headers, rows) = Shared.toLegacyTable caption specs thead tbodies tfoot - pushSimpleTable $ SimpleTable capt aligns widths headers rows - return (NumResults 1) - blk -> - Lua.throwMessage $ - "Expected Table, got " <> showConstr (toConstr blk) <> "." - --- | Convert a number < 4000 to uppercase roman numeral. -toRomanNumeral :: Lua.Integer -> PandocLua T.Text -toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral + return $ SimpleTable capt aligns widths headers rows + blk -> Lua.failLua $ mconcat + [ "Expected Table, got ", showConstr (toConstr blk), "." ] + +peekTable :: LuaError e => Peeker e Block +peekTable idx = peekBlock idx >>= \case + t@(Table {}) -> return t + b -> Lua.failPeek $ mconcat + [ "Expected Table, got " + , UTF8.fromString $ showConstr (toConstr b) + , "." ] -- cgit v1.2.3 From c07005a095960bc1a3e012fec5a23bf4c70185f5 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 21 Oct 2021 11:11:27 +0200 Subject: Lua: marshal Version values as userdata --- pandoc.cabal | 2 +- src/Text/Pandoc/Lua/Global.hs | 5 +- src/Text/Pandoc/Lua/Marshaling.hs | 1 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 5 ++ src/Text/Pandoc/Lua/Marshaling/Version.hs | 118 ------------------------------ src/Text/Pandoc/Lua/Module/Types.hs | 6 +- src/Text/Pandoc/Lua/Module/Utils.hs | 2 +- 7 files changed, 13 insertions(+), 126 deletions(-) delete mode 100644 src/Text/Pandoc/Lua/Marshaling/Version.hs (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/pandoc.cabal b/pandoc.cabal index 9cf609049..caf91adff 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -556,6 +556,7 @@ library hslua-module-path >= 1.0 && < 1.1, hslua-module-system >= 1.0 && < 1.1, hslua-module-text >= 1.0 && < 1.1, + hslua-module-version >= 1.0 && < 1.1, http-client >= 0.4.30 && < 0.8, http-client-tls >= 0.2.4 && < 0.4, http-types >= 0.8 && < 0.13, @@ -783,7 +784,6 @@ library Text.Pandoc.Lua.Marshaling.PandocError, Text.Pandoc.Lua.Marshaling.ReaderOptions, Text.Pandoc.Lua.Marshaling.SimpleTable, - Text.Pandoc.Lua.Marshaling.Version, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index df300a8c6..23b3a8284 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -15,6 +15,7 @@ module Text.Pandoc.Lua.Global ) where import HsLua as Lua +import HsLua.Module.Version (pushVersion) import Paths_pandoc (version) import Text.Pandoc.Class.CommonState (CommonState) import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion) @@ -48,7 +49,7 @@ setGlobal global = case global of Lua.push format Lua.setglobal "FORMAT" PANDOC_API_VERSION -> do - Lua.push pandocTypesVersion + pushVersion pandocTypesVersion Lua.setglobal "PANDOC_API_VERSION" PANDOC_DOCUMENT doc -> do pushUD typePandocLazy doc @@ -63,7 +64,7 @@ setGlobal global = case global of pushCommonState commonState Lua.setglobal "PANDOC_STATE" PANDOC_VERSION -> do - Lua.push version + pushVersion version Lua.setglobal "PANDOC_VERSION" -- | Readonly and lazy pandoc objects. diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs index 8fde94958..e217b8852 100644 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ b/src/Text/Pandoc/Lua/Marshaling.hs @@ -16,5 +16,4 @@ import Text.Pandoc.Lua.Marshaling.CommonState () import Text.Pandoc.Lua.Marshaling.Context () import Text.Pandoc.Lua.Marshaling.PandocError() import Text.Pandoc.Lua.Marshaling.ReaderOptions () -import Text.Pandoc.Lua.Marshaling.Version () import Text.Pandoc.Lua.ErrorConversion () diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 1e635483c..5791b39c1 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -48,7 +48,9 @@ import Control.Monad.Catch (throwM) import Control.Monad ((<$!>), (>=>)) import Data.Data (showConstr, toConstr) import Data.Text (Text) +import Data.Version (Version) import HsLua hiding (Operation (Div)) +import HsLua.Module.Version (peekVersionFuzzy) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocLuaError)) import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor) @@ -616,5 +618,8 @@ instance Peekable Meta where instance Peekable Pandoc where peek = forcePeek . peekPandoc +instance Peekable Version where + peek = forcePeek . peekVersionFuzzy + instance {-# OVERLAPPING #-} Peekable Attr where peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Marshaling/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs deleted file mode 100644 index 2af36e5c8..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Version.hs +++ /dev/null @@ -1,118 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.Version - Copyright : © 2019-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling of @'Version'@s. The marshaled elements can be compared using -default comparison operators (like @>@ and @<=@). --} -module Text.Pandoc.Lua.Marshaling.Version - ( peekVersion - , pushVersion - , peekVersionFuzzy - ) - where - -import Data.Maybe (fromMaybe) -import Data.Version (Version (..), makeVersion, parseVersion, showVersion) -import HsLua as Lua -import Safe (lastMay) -import Text.ParserCombinators.ReadP (readP_to_S) -import qualified Text.Pandoc.UTF8 as UTF8 - -instance Peekable Version where - peek = forcePeek . peekVersionFuzzy - -instance Pushable Version where - push = pushVersion - --- | Push a @'Version'@ element to the Lua stack. -pushVersion :: LuaError e => Pusher e Version -pushVersion = pushUD typeVersion - -peekVersionFuzzy :: LuaError e => Peeker e Version -peekVersionFuzzy idx = retrieving "Version" $ liftLua (Lua.ltype idx) >>= \case - Lua.TypeUserdata -> peekVersion idx - Lua.TypeString -> do - versionStr <- peekString idx - let parses = readP_to_S parseVersion versionStr - case lastMay parses of - Just (v, "") -> return v - _ -> Lua.failPeek $ - UTF8.fromString $ "could not parse as Version: " ++ versionStr - - Lua.TypeNumber -> do - (makeVersion . (:[])) <$> peekIntegral idx - - Lua.TypeTable -> - makeVersion <$> peekList peekIntegral idx - - _ -> - Lua.failPeek "could not peek Version" - -peekVersion :: LuaError e => Peeker e Version -peekVersion = peekUD typeVersion - -typeVersion :: LuaError e => DocumentedType e Version -typeVersion = deftype "Version" - [ operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter peekVersionFuzzy "Version" "v1" "" - <#> parameter peekVersionFuzzy "Version" "v2" "" - =#> functionResult pushBool "boolean" "true iff v1 == v2" - , operation Lt $ defun "__lt" - ### liftPure2 (<) - <#> parameter peekVersionFuzzy "Version" "v1" "" - <#> parameter peekVersionFuzzy "Version" "v2" "" - =#> functionResult pushBool "boolean" "true iff v1 < v2" - , operation Le $ defun "__le" - ### liftPure2 (<=) - <#> parameter peekVersionFuzzy "Version" "v1" "" - <#> parameter peekVersionFuzzy "Version" "v2" "" - =#> functionResult pushBool "boolean" "true iff v1 <= v2" - , operation Len $ defun "__len" - ### liftPure (length . versionBranch) - <#> parameter peekVersionFuzzy "Version" "v1" "" - =#> functionResult pushIntegral "integer" "number of version components" - , operation Tostring $ defun "__tostring" - ### liftPure showVersion - <#> parameter peekVersionFuzzy "Version" "version" "" - =#> functionResult pushString "string" "stringified version" - ] - [ method $ defun "must_be_at_least" - ### must_be_at_least - <#> parameter peekVersionFuzzy "Version" "self" "version to check" - <#> parameter peekVersionFuzzy "Version" "reference" "minimum version" - <#> optionalParameter peekString "string" "msg" "alternative message" - =?> "Returns no result, and throws an error if this version is older than reference" - ] - --- | Throw an error if this version is older than the given version. --- FIXME: This function currently requires the string library to be --- loaded. -must_be_at_least :: LuaError e - => Version -> Version -> Maybe String - -> LuaE e NumResults -must_be_at_least actual expected mMsg = do - let msg = fromMaybe versionTooOldMessage mMsg - if expected <= actual - then return 0 - else do - Lua.getglobal' "string.format" - Lua.push msg - Lua.push (showVersion expected) - Lua.push (showVersion actual) - Lua.call 3 1 - Lua.error - --- | Default error message when a version is too old. This message is --- formatted in Lua with the expected and actual versions as arguments. -versionTooOldMessage :: String -versionTooOldMessage = "expected version %s or newer, got %s" diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index a9ce14ce7..7307c6e88 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -13,21 +13,21 @@ module Text.Pandoc.Lua.Module.Types ( pushModule ) where -import Data.Version (Version) import HsLua (LuaE, NumResults, Peeker, Pusher) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.Version () import Text.Pandoc.Lua.Util (addFunction) import qualified HsLua as Lua +import qualified HsLua.Module.Version as Version -- | Push the pandoc.types module on the Lua stack. pushModule :: LuaE PandocError NumResults pushModule = do Lua.newtable - addFunction "Version" (return :: Version -> LuaE PandocError Version) + Lua.pushName "Version" *> Lua.pushModule Version.documentedModule + *> Lua.rawset (Lua.nth 3) pushCloneTable Lua.setfield (Lua.nth 2) "clone" return 1 diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 8b6e31b43..7ce1cd18d 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -23,6 +23,7 @@ import Data.Default (def) import Data.Version (Version) import HsLua as Lua hiding (pushModule) import HsLua.Class.Peekable (PeekError) +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () @@ -32,7 +33,6 @@ import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) -import Text.Pandoc.Lua.Marshaling.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA -- cgit v1.2.3 From f56d8706312df64d3956cea0c93768b51192958e Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 26 Oct 2021 14:40:11 +0200 Subject: Lua: marshal ListAttributes values as userdata objects --- data/pandoc.lua | 42 -------------- pandoc.cabal | 1 + src/Text/Pandoc/Lua/Init.hs | 1 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 14 +---- src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs | 72 ++++++++++++++++++++++++ src/Text/Pandoc/Lua/Module/Pandoc.hs | 4 ++ src/Text/Pandoc/Lua/Module/Types.hs | 1 - src/Text/Pandoc/Lua/Module/Utils.hs | 3 +- 8 files changed, 81 insertions(+), 57 deletions(-) create mode 100644 src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/data/pandoc.lua b/data/pandoc.lua index a20ce1e8c..2bbf0213e 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -349,48 +349,6 @@ function M.MetaBool(bool) end ------------------------------------------------------------------------ --- Element components --- @section components - --- ListAttributes -M.ListAttributes = AstElement:make_subtype 'ListAttributes' -M.ListAttributes.behavior.clone = M.types.clone.ListAttributes - ---- Creates a set of list attributes. --- @function ListAttributes --- @tparam[opt] integer start number of the first list item --- @tparam[opt] string style style used for list numbering --- @tparam[opt] DefaultDelim|Period|OneParen|TwoParens delimiter delimiter of list numbers --- @treturn table list attributes table -function M.ListAttributes:new (start, style, delimiter) - start = start or 1 - style = style or 'DefaultStyle' - delimiter = delimiter or 'DefaultDelim' - return {start, style, delimiter} -end -M.ListAttributes.behavior._field_names = {start = 1, style = 2, delimiter = 3} -M.ListAttributes.behavior.__eq = utils.equals -M.ListAttributes.behavior.__index = function (t, k) - return rawget(t, getmetatable(t)._field_names[k]) or - getmetatable(t)[k] -end -M.ListAttributes.behavior.__newindex = function (t, k, v) - if getmetatable(t)._field_names[k] then - rawset(t, getmetatable(t)._field_names[k], v) - else - rawset(t, k, v) - end -end -M.ListAttributes.behavior.__pairs = function(t) - local field_names = M.ListAttributes.behavior._field_names - local fields = {} - for name, i in pairs(field_names) do - fields[i] = name - end - return make_next_function(fields), t, nil -end - --- -- Legacy and compatibility types -- diff --git a/pandoc.cabal b/pandoc.cabal index ca9fc9245..458e69ab6 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -781,6 +781,7 @@ library Text.Pandoc.Lua.Marshaling.CommonState, Text.Pandoc.Lua.Marshaling.Context, Text.Pandoc.Lua.Marshaling.List, + Text.Pandoc.Lua.Marshaling.ListAttributes, Text.Pandoc.Lua.Marshaling.PandocError, Text.Pandoc.Lua.Marshaling.ReaderOptions, Text.Pandoc.Lua.Marshaling.SimpleTable, diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index 60475e25c..87ae3a0d2 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -85,7 +85,6 @@ putConstructorsInRegistry :: PandocLua () putConstructorsInRegistry = liftPandocLua $ do constrsToReg $ Pandoc.Meta mempty constrsToReg $ Pandoc.MetaList mempty - putInReg "ListAttributes" -- used for ListAttributes type alias putInReg "List" -- pandoc.List putInReg "SimpleTable" -- helper for backward-compatible table handling where diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 22c78bff9..d723fcb4c 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -31,7 +31,6 @@ module Text.Pandoc.Lua.Marshaling.AST , peekInlineFuzzy , peekInlines , peekInlinesFuzzy - , peekListAttributes , peekMeta , peekMetaValue , peekPandoc @@ -63,6 +62,8 @@ import Text.Pandoc.Error (PandocError (PandocLuaError)) import Text.Pandoc.Lua.Util (pushViaConstr') import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshaling.ListAttributes + (peekListAttributes, pushListAttributes) import qualified HsLua as Lua import qualified Text.Pandoc.Lua.Util as LuaUtil @@ -794,17 +795,6 @@ peekBlocksFuzzy = choice , (<$!>) pure . peekBlockFuzzy ] -pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e () -pushListAttributes (start, style, delimiter) = - pushViaConstr' "ListAttributes" - [ push start, push style, push delimiter ] - -peekListAttributes :: LuaError e => Peeker e ListAttributes -peekListAttributes = retrieving "ListAttributes" . peekTriple - peekIntegral - peekRead - peekRead - -- * Orphan Instances instance Pushable Inline where diff --git a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs new file mode 100644 index 000000000..5a6608644 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{- | +Module : Text.Pandoc.Lua.Marshaling.ListAttributes +Copyright : © 2021 Albert Krewinkel +License : GNU GPL, version 2 or above +Maintainer : Albert Krewinkel + +Marshaling/unmarshaling functions and constructor for 'ListAttributes' +values. +-} +module Text.Pandoc.Lua.Marshaling.ListAttributes + ( typeListAttributes + , peekListAttributes + , pushListAttributes + , mkListAttributes + ) where + +import Data.Maybe (fromMaybe) +import HsLua +import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (DefaultStyle) + , ListNumberDelim (DefaultDelim)) + +typeListAttributes :: LuaError e => DocumentedType e ListAttributes +typeListAttributes = deftype "ListAttributes" + [ operation Eq $ lambda + ### liftPure2 (==) + <#> parameter peekListAttributes "a" "ListAttributes" "" + <#> parameter peekListAttributes "b" "ListAttributes" "" + =#> functionResult pushBool "boolean" "whether the two are equal" + ] + [ property "start" "number of the first list item" + (pushIntegral, \(start,_,_) -> start) + (peekIntegral, \(_,style,delim) -> (,style,delim)) + , property "style" "style used for list numbering" + (pushString . show, \(_,classes,_) -> classes) + (peekRead, \(start,_,delim) -> (start,,delim)) + , property "delimiter" "delimiter of list numbers" + (pushString . show, \(_,_,delim) -> delim) + (peekRead, \(start,style,_) -> (start,style,)) + , method $ defun "clone" + ### return + <#> udparam typeListAttributes "a" "" + =#> functionResult (pushUD typeListAttributes) "ListAttributes" + "cloned ListAttributes value" + ] + +-- | Pushes a 'ListAttributes' value as userdata object. +pushListAttributes :: LuaError e => Pusher e ListAttributes +pushListAttributes = pushUD typeListAttributes + +-- | Retrieve a 'ListAttributes' triple, either from userdata or from a +-- Lua tuple. +peekListAttributes :: LuaError e => Peeker e ListAttributes +peekListAttributes = retrieving "ListAttributes" . choice + [ peekUD typeListAttributes + , peekTriple peekIntegral peekRead peekRead + ] + +-- | Constructor for a new 'ListAttributes' value. +mkListAttributes :: LuaError e => DocumentedFunction e +mkListAttributes = defun "ListAttributes" + ### liftPure3 (\mstart mstyle mdelim -> + ( fromMaybe 1 mstart + , fromMaybe DefaultStyle mstyle + , fromMaybe DefaultDelim mdelim + )) + <#> optionalParameter peekIntegral "integer" "start" "number of first item" + <#> optionalParameter peekRead "string" "style" "list numbering style" + <#> optionalParameter peekRead "string" "delimiter" "list number delimiter" + =#> functionResult pushListAttributes "ListAttributes" "new ListAttributes" + #? "Creates a new ListAttributes object." diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index f08914eba..340c324ad 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -34,6 +34,8 @@ import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) import Text.Pandoc.Lua.Marshaling.List (List (..)) +import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes + , peekListAttributes) import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) @@ -301,6 +303,8 @@ otherConstructors = <#> optionalParameter peekIntegral "hash" "integer" "hash number" =#> functionResult pushCitation "Citation" "new citation object" #? "Creates a single citation." + + , mkListAttributes ] walkElement :: (Walkable (SingletonsList Inline) a, diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index fb09235de..ff4a4e0d5 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -37,7 +37,6 @@ pushCloneTable = do Lua.newtable addFunction "Meta" $ cloneWith peekMeta Lua.push addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - addFunction "ListAttributes" $ cloneWith peekListAttributes pushListAttributes return 1 cloneWith :: Peeker PandocError a diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 7ce1cd18d..f83c34af7 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -29,7 +29,8 @@ import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushPandoc - , peekAttr, peekListAttributes, peekMeta, peekMetaValue) + , peekAttr, peekMeta, peekMetaValue) +import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) -- cgit v1.2.3 From b990ca3c4cadf0da0d17a71809cf0a87c67eb175 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 27 Oct 2021 20:56:30 +0200 Subject: Lua: fix `pandoc.utils.stringify` regression The `pandoc.utils.stringify` function returned empty strings when called with a string argument. --- src/Text/Pandoc/Lua/Module/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index f83c34af7..3602612cb 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -185,10 +185,10 @@ peekAstElement = retrieving "pandoc AST element" . choice [ (fmap PandocElement . peekPandoc) , (fmap InlineElement . peekInline) , (fmap BlockElement . peekBlock) + , (fmap MetaValueElement . peekMetaValue) , (fmap AttrElement . peekAttr) , (fmap ListAttributesElement . peekListAttributes) , (fmap MetaElement . peekMeta) - , (fmap MetaValueElement . peekMetaValue) ] -- | Converts an old/simple table into a normal table block element. -- cgit v1.2.3 From f4d9b443d8b44b802d564a64280cbe9ea89dacc8 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 29 Oct 2021 17:08:03 +0200 Subject: Lua: use hslua module abstraction where possible This will make it easier to generate module documentation in the future. --- data/pandoc.lua | 120 +-------------- src/Text/Pandoc/Lua/Filter.hs | 33 +++-- src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 + src/Text/Pandoc/Lua/Marshaling/Attr.hs | 50 ++++--- src/Text/Pandoc/Lua/Module/MediaBag.hs | 160 ++++++++++---------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 258 ++++++++++++++++++++------------- src/Text/Pandoc/Lua/Module/System.hs | 44 +++--- src/Text/Pandoc/Lua/Module/Types.hs | 56 ++++--- src/Text/Pandoc/Lua/Module/Utils.hs | 26 ++-- src/Text/Pandoc/Lua/Packages.hs | 26 ++-- src/Text/Pandoc/Lua/PandocLua.hs | 8 - src/Text/Pandoc/Lua/Util.hs | 9 -- test/lua/module/pandoc.lua | 6 + 13 files changed, 385 insertions(+), 412 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/data/pandoc.lua b/data/pandoc.lua index cc4dc0cab..1f4830858 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -45,125 +45,19 @@ local utils = M.utils -- @section -- @local ---- Create a new indexing function. --- @param template function template --- @param indices list of indices, starting with the most deeply nested --- @return newly created function --- @local -function make_indexing_function(template, ...) - local indices = {...} - local loadstring = loadstring or load - local bracketed = {} - for i = 1, #indices do - local idx = indices[#indices - i + 1] - bracketed[i] = type(idx) == 'number' - and string.format('[%d]', idx) - or string.format('.%s', idx) - end - local fnstr = string.format('return ' .. template, table.concat(bracketed)) - return assert(loadstring(fnstr))() -end - ---- Create accessor functions using a function template. --- @param fn_template function template in which '%s' is replacd with indices --- @param accessors list of accessors --- @return mapping from accessor names to accessor functions --- @local -local function create_accessor_functions (fn_template, accessors) - local res = {} - function add_accessors(acc, ...) - if type(acc) == 'string' then - res[acc] = make_indexing_function(fn_template, ...) - elseif type(acc) == 'table' and #acc == 0 and next(acc) then - -- Named substructure: the given names are accessed via the substructure, - -- but the accessors are also added to the result table, enabling direct - -- access from the parent element. Mainly used for `attr`. - local name, substructure = next(acc) - res[name] = make_indexing_function(fn_template, ...) - for _, subname in ipairs(substructure) do - res[subname] = make_indexing_function(fn_template, subname, ...) - end - else - for i = 1, #(acc or {}) do - add_accessors(acc[i], i, ...) - end - end - end - add_accessors(accessors) - return res -end - ---- Get list of top-level fields from field descriptor table. --- E.g.: `top_level_fields{'foo', {bar='baz'}, {'qux', 'quux'}}` --- gives {'foo, 'bar', 'qux', 'quux'} --- @local -local function top_level_fields (fields) - local result = List:new{} - for _, v in ipairs(fields) do - if type(v) == 'string' then - table.insert(result, v) - elseif type(v) == 'table' and #v == 0 and next(v) then - table.insert(result, (next(v))) - else - result:extend(top_level_fields(v)) - end - end - return result -end - ---- Creates a function which behaves like next, but respects field names. --- @local -local function make_next_function (fields) - local field_indices = {} - for i, f in ipairs(fields) do - field_indices[f] = i - end - - return function (t, field) - local raw_idx = field == nil and 0 or field_indices[field] - local next_field = fields[raw_idx + 1] - return next_field, t[next_field] - end -end - --- Create a new table which allows to access numerical indices via accessor -- functions. -- @local -local function create_accessor_behavior (tag, accessors) +local function create_accessor_behavior (tag) local behavior = {tag = tag} - behavior.getters = create_accessor_functions( - 'function (x) return x.c%s end', - accessors - ) - behavior.setters = create_accessor_functions( - 'function (x, v) x.c%s = v end', - accessors - ) behavior.__eq = utils.equals behavior.__index = function(t, k) - if getmetatable(t).getters[k] then - return getmetatable(t).getters[k](t) - elseif k == "t" then + if k == "t" then return getmetatable(t)["tag"] - else - return getmetatable(t)[k] - end - end - behavior.__newindex = function(t, k, v) - if getmetatable(t).setters[k] then - getmetatable(t).setters[k](t, v) - else - rawset(t, k, v) end end behavior.__pairs = function (t) - if accessors == nil then - return next, t - end - local iterable_fields = type(accessors) == 'string' - and {accessors} - or top_level_fields(accessors) - return make_next_function(iterable_fields), t + return next, t end return behavior end @@ -242,8 +136,8 @@ end -- @param fn Function to be called when constructing a new element -- @param accessors names to use as accessors for numerical fields -- @return function that constructs a new element -function AstElement:create_constructor(tag, fn, accessors) - local constr = self:make_subtype(tag, create_accessor_behavior(tag, accessors)) +function AstElement:create_constructor(tag, fn) + local constr = self:make_subtype(tag, create_accessor_behavior(tag)) function constr:new(...) return setmetatable(fn(...), self.behavior) end @@ -348,8 +242,4 @@ function M.MetaBool(bool) return bool end ------------------------------------------------------------------------- --- Functions which have moved to different modules -M.sha1 = utils.sha1 - return M diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9a06dcac6..9fd0ef32c 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -14,6 +14,7 @@ Types and functions for running Lua filters. -} module Text.Pandoc.Lua.Filter ( LuaFilterFunction , LuaFilter + , peekLuaFilter , runFilterFile , walkInlines , walkInlineLists @@ -68,20 +69,24 @@ newtype LuaFilterFunction = LuaFilterFunction Lua.Reference newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) instance Peekable LuaFilter where - peek idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs + peek = Lua.forcePeek . peekLuaFilter + +-- | Retrieves a LuaFilter object from the stack. +peekLuaFilter :: LuaError e => Peeker e LuaFilter +peekLuaFilter idx = do + let constrs = listOfInlinesFilterName + : listOfBlocksFilterName + : metaFilterName + : pandocFilterNames + ++ blockElementNames + ++ inlineElementNames + let go constr acc = Lua.liftLua $ do + Lua.getfield idx constr + filterFn <- registerFilterFunction + return $ case filterFn of + Nothing -> acc + Just fn -> Map.insert constr fn acc + LuaFilter <$!> foldrM go Map.empty constrs -- | Register the function at the top of the stack as a filter function in the -- registry. diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 6bb4fd4e0..aabc9e530 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -45,6 +45,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushCitation , pushInline , pushListAttributes + , pushMeta , pushMetaValue , pushPandoc ) where diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs index 2f1f2406a..a38bc6ec7 100644 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ b/src/Text/Pandoc/Lua/Marshaling/Attr.hs @@ -204,26 +204,30 @@ peekAttrTable idx = do return $ ident `seq` classes `seq` attribs `seq` (ident, classes, attribs) -mkAttr :: LuaError e => LuaE e NumResults -mkAttr = do - attr <- ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return (fromMaybe "" mident, fromMaybe [] mclass, fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x - pushAttr attr - return 1 - -mkAttributeList :: LuaError e => LuaE e NumResults -mkAttributeList = do - attribs <- forcePeek $ peekAttribs (nthBottom 1) - pushUD typeAttributeList attribs - return 1 +-- | Constructor for 'Attr'. +mkAttr :: LuaError e => DocumentedFunction e +mkAttr = defun "Attr" + ### (ltype (nthBottom 1) >>= \case + TypeString -> forcePeek $ do + mident <- optional (peekText (nthBottom 1)) + mclass <- optional (peekList peekText (nthBottom 2)) + mattribs <- optional (peekAttribs (nthBottom 3)) + return ( fromMaybe "" mident + , fromMaybe [] mclass + , fromMaybe [] mattribs) + TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) + TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do + attrList <- peekUD typeAttributeList (nthBottom 1) + return ("", [], attrList) + TypeNil -> pure nullAttr + TypeNone -> pure nullAttr + x -> failLua $ "Cannot create Attr from " ++ show x) + =#> functionResult pushAttr "Attr" "new Attr object" + +-- | Constructor for 'AttributeList'. +mkAttributeList :: LuaError e => DocumentedFunction e +mkAttributeList = defun "AttributeList" + ### return + <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" + =#> functionResult (pushUD typeAttributeList) "AttributeList" + "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index a1fc40732..6e595f9e4 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -1,112 +1,126 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Lua.Module.MediaBag Copyright : Copyright © 2017-2021 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha -The lua module @pandoc.mediabag@. +The Lua module @pandoc.mediabag@. -} module Text.Pandoc.Lua.Module.MediaBag - ( pushModule + ( documentedModule ) where import Prelude hiding (lookup) -import Control.Monad (zipWithM_) -import HsLua (LuaE, NumResults, Optional) -import HsLua.Marshalling (pushIterator) +import Data.Maybe (fromMaybe) +import HsLua ( LuaE, DocumentedFunction, Module (..) + , (<#>), (###), (=#>), (=?>), defun, functionResult + , optionalParameter , parameter) import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction) +import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) import qualified Data.ByteString.Lazy as BL -import qualified Data.Text as T import qualified HsLua as Lua import qualified Text.Pandoc.MediaBag as MB -- -- MediaBag submodule -- -pushModule :: PandocLua NumResults -pushModule = do - liftPandocLua Lua.newtable - addFunction "delete" delete - addFunction "empty" empty - addFunction "insert" insert - addFunction "items" items - addFunction "lookup" lookup - addFunction "list" list - addFunction "fetch" fetch - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.mediabag" + , moduleDescription = "mediabag access" + , moduleFields = [] + , moduleFunctions = + [ delete + , empty + , fetch + , insert + , items + , list + , lookup + ] + , moduleOperations = [] + } -- | Delete a single item from the media bag. -delete :: FilePath -> PandocLua NumResults -delete fp = 0 <$ modifyCommonState - (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) }) +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" + =#> [] + -- | Delete all items from the media bag. -empty :: PandocLua NumResults -empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty }) +empty :: DocumentedFunction PandocError +empty = defun "empty" + ### unPandocLua (modifyCommonState (\st -> st { stMediaBag = mempty })) + =#> [] -- | Insert a new item into the media bag. -insert :: FilePath - -> Optional MimeType - -> BL.ByteString - -> PandocLua NumResults -insert fp optionalMime contents = do - mb <- getMediaBag - setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb - return (Lua.NumResults 0) +insert :: DocumentedFunction PandocError +insert = defun "insert" + ### (\fp mmime contents -> unPandocLua $ do + 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" + <#> parameter Lua.peekLazyByteString "string" "contents" "binary contents" + =?> "Nothing" -- | Returns iterator values to be used with a Lua @for@ loop. -items :: PandocLua NumResults -items = do - mb <- getMediaBag - liftPandocLua $ do - let pushItem (fp, mimetype, contents) = do - Lua.pushString fp - Lua.pushText mimetype - Lua.pushByteString $ BL.toStrict contents - return (Lua.NumResults 3) - pushIterator pushItem (MB.mediaItems mb) +items :: DocumentedFunction PandocError +items = defun "items" + ### (do + mb <-unPandocLua getMediaBag + let pushItem (fp, mimetype, contents) = do + Lua.pushString fp + Lua.pushText mimetype + Lua.pushByteString $ BL.toStrict contents + return (Lua.NumResults 3) + Lua.pushIterator pushItem (MB.mediaItems mb)) + =?> "Iterator triple" -lookup :: FilePath - -> PandocLua NumResults -lookup fp = do - res <- MB.lookupMedia fp <$> getMediaBag - liftPandocLua $ case res of - Nothing -> 1 <$ Lua.pushnil - Just item -> do - Lua.push $ MB.mediaMimeType item - Lua.push $ MB.mediaContents item - return 2 +-- | Function to lookup a value in the mediabag. +lookup :: DocumentedFunction PandocError +lookup = defun "lookup" + ### (\fp -> unPandocLua (MB.lookupMedia fp <$> getMediaBag) >>= \case + Nothing -> 1 <$ Lua.pushnil + Just item -> 2 <$ do + Lua.pushText $ MB.mediaMimeType item + Lua.pushLazyByteString $ MB.mediaContents item) + <#> parameter Lua.peekString "string" "filepath" "path of item to lookup" + =?> "MIME type and contents" -list :: PandocLua NumResults -list = do - dirContents <- MB.mediaDirectory <$> getMediaBag - liftPandocLua $ do - Lua.newtable - zipWithM_ addEntry [1..] dirContents - return 1 +-- | Function listing all mediabag items. +list :: DocumentedFunction PandocError +list = defun "list" + ### (unPandocLua (MB.mediaDirectory <$> getMediaBag)) + =#> functionResult (pushPandocList pushEntry) "table" "list of entry triples" where - addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError () - addEntry idx (fp, mimeType, contentLength) = do + pushEntry :: (FilePath, MimeType, Int) -> LuaE PandocError () + pushEntry (fp, mimeType, contentLength) = do Lua.newtable - Lua.push ("path" :: T.Text) *> Lua.push fp *> Lua.rawset (-3) - Lua.push ("type" :: T.Text) *> Lua.push mimeType *> Lua.rawset (-3) - Lua.push ("length" :: T.Text) *> Lua.push contentLength *> Lua.rawset (-3) - Lua.rawseti (-2) idx + Lua.pushName "path" *> Lua.pushString fp *> Lua.rawset (-3) + Lua.pushName "type" *> Lua.pushText mimeType *> Lua.rawset (-3) + Lua.pushName "length" *> Lua.pushIntegral contentLength *> Lua.rawset (-3) -fetch :: T.Text - -> PandocLua NumResults -fetch src = do - (bs, mimeType) <- fetchItem src - liftPandocLua . Lua.push $ maybe "" T.unpack mimeType - liftPandocLua $ Lua.push bs - return 2 -- returns 2 values: contents, mimetype +-- | Lua function to retrieve a new item. +fetch :: DocumentedFunction PandocError +fetch = defun "fetch" + ### (\src -> do + (bs, mimeType) <- unPandocLua $ fetchItem src + Lua.pushText $ fromMaybe "" mimeType + Lua.pushByteString bs + return 2) + <#> parameter Lua.peekText "string" "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 7bad3f1a5..6d1ccea04 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,11 +15,12 @@ Pandoc module for lua. -} module Text.Pandoc.Lua.Module.Pandoc ( pushModule + , documentedModule ) where import Prelude hiding (read) -import Control.Applicative ((<|>), optional) -import Control.Monad ((>=>), (<$!>), forM_, when) +import Control.Applicative ((<|>)) +import Control.Monad ((<$!>), forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) @@ -26,13 +28,14 @@ import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) -import HsLua as Lua hiding (Div, pushModule) +import HsLua hiding (Div, pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines, - walkInlineLists, walkBlocks, walkBlockLists) +import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, + walkInlines, walkInlineLists, + walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) @@ -40,13 +43,15 @@ import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes , peekListAttributes) import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) -import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, +import Text.Pandoc.Lua.Module.Utils (sha1) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) import Text.Pandoc.Walk (Walkable) +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 @@ -57,45 +62,74 @@ import Text.Pandoc.Error -- module to be loadable. pushModule :: PandocLua NumResults pushModule = do + liftPandocLua $ Lua.pushModule documentedModule loadDefaultModule "pandoc" - addFunction "read" read - addFunction "pipe" pipe - addFunction "walk_block" (walkElement peekBlock pushBlock) - addFunction "walk_inline" (walkElement peekInline pushInline) - -- Constructors - addFunction "Attr" (liftPandocLua mkAttr) - addFunction "AttributeList" (liftPandocLua mkAttributeList) - addFunction "Pandoc" mkPandoc + let copyNext = do + hasNext <- next (nth 2) + if not hasNext + then return () + else do + pushvalue (nth 2) + insert (nth 2) + rawset (nth 5) -- pandoc module + copyNext liftPandocLua $ do - let addConstr fn = do - pushName (functionName fn) - pushDocumentedFunction fn - rawset (nth 3) - forM_ otherConstructors addConstr - forM_ blockConstructors addConstr - forM_ inlineConstructors addConstr - let addConstructorTable constructors = do - -- add constructors to Inlines.constructor - newtable -- constructor - forM_ constructors $ \fn -> do - let name = functionName fn - pushName name - pushName name - rawget (nth 4) - rawset (nth 3) - -- set as pandoc.Inline.constructor - pushName "Inline" - newtable *> pushName "constructor" *> - pushvalue (nth 4) *> rawset (nth 3) - rawset (nth 4) - pop 1 -- remaining constructor table - addConstructorTable (blockConstructors @PandocError) - addConstructorTable (inlineConstructors @PandocError) - -- Add string constants - forM_ stringConstants $ \c -> do - pushString c *> pushString c *> rawset (nth 3) + pushnil -- initial key + copyNext + pop 1 + return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc" + , moduleDescription = T.unlines + [ "Lua functions for pandoc scripts; includes constructors for" + , "document elements, functions to parse text in a given" + , "format, and functions to filter and modify a subtree." + ] + , moduleFields = stringConstants ++ [inlineField, blockField] + , moduleOperations = [] + , moduleFunctions = mconcat + [ functions + , otherConstructors + , blockConstructors + , inlineConstructors + ] + } + +-- | Inline table field +inlineField :: Field PandocError +inlineField = Field + { fieldName = "Inline" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable inlineConstructors + } + +-- | @Block@ module field +blockField :: Field PandocError +blockField = Field + { fieldName = "Block" + , fieldDescription = "Inline constructors, nested under 'constructors'." + -- the nesting happens for historical reasons and should probably be + -- changed. + , fieldPushValue = pushWithConstructorsSubtable blockConstructors + } + +pushWithConstructorsSubtable :: [DocumentedFunction PandocError] + -> LuaE PandocError () +pushWithConstructorsSubtable constructors = do + newtable -- Field table + newtable -- constructor table + pushName "constructor" *> pushvalue (nth 2) *> rawset (nth 4) + forM_ constructors $ \fn -> do + pushName (functionName fn) + pushDocumentedFunction fn + rawset (nth 3) + pop 1 -- pop constructor table + inlineConstructors :: LuaError e => [DocumentedFunction e] inlineConstructors = [ defun "Cite" @@ -291,7 +325,13 @@ mkInlinesConstr name constr = defun name otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Citation" + [ defun "Pandoc" + ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) + <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" + <#> optionalParameter peekMeta "Meta" "meta" "document metadata" + =#> functionResult pushPandoc "Pandoc" "new Pandoc document" + + , defun "Citation" ### (\cid mode mprefix msuffix mnote_num mhash -> cid `seq` mode `seq` mprefix `seq` msuffix `seq` mnote_num `seq` mhash `seq` return $! Citation @@ -311,68 +351,93 @@ otherConstructors = =#> functionResult pushCitation "Citation" "new citation object" #? "Creates a single citation." + , mkAttr + , mkAttributeList , mkListAttributes , mkSimpleTable ] -stringConstants :: [String] +stringConstants :: [Field e] stringConstants = let constrs :: forall a. Data a => Proxy a -> [String] constrs _ = map showConstr . dataTypeConstrs . dataTypeOf @a $ undefined - in constrs (Proxy @ListNumberStyle) - ++ constrs (Proxy @ListNumberDelim) - ++ constrs (Proxy @QuoteType) - ++ constrs (Proxy @MathType) - ++ constrs (Proxy @Alignment) - ++ constrs (Proxy @CitationMode) + nullaryConstructors = mconcat + [ constrs (Proxy @ListNumberStyle) + , constrs (Proxy @ListNumberDelim) + , constrs (Proxy @QuoteType) + , constrs (Proxy @MathType) + , constrs (Proxy @Alignment) + , constrs (Proxy @CitationMode) + ] + toField s = Field + { fieldName = T.pack s + , fieldDescription = T.pack s + , fieldPushValue = pushString s + } + in map toField nullaryConstructors walkElement :: (Walkable (SingletonsList Inline) a, Walkable (SingletonsList Block) a, Walkable (List Inline) a, Walkable (List Block) a) - => Peeker PandocError a -> Pusher PandocError a - -> LuaE PandocError NumResults -walkElement peek' push' = do - x <- forcePeek $ peek' (nthBottom 1) - f <- peek (nthBottom 2) - let walk' = walkInlines f - >=> walkInlineLists f - >=> walkBlocks f - >=> walkBlockLists f - walk' x >>= push' - return (NumResults 1) - -read :: T.Text -> Optional T.Text -> PandocLua NumResults -read content formatSpecOrNil = liftPandocLua $ do - let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) - res <- Lua.liftIO . runIO $ - getReader formatSpec >>= \(rdr,es) -> - case rdr of - TextReader r -> - r def{ readerExtensions = es } content - _ -> throwError $ PandocSomeError - "Only textual formats are supported" - case res of - Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc - Left (PandocUnknownReaderError f) -> Lua.raiseError $ - "Unknown reader: " <> f - Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ - "Extension " <> e <> " not supported for " <> f - Left e -> Lua.raiseError $ show e - --- | Pipes input through a command. -pipe :: String -- ^ path to executable - -> [String] -- ^ list of arguments - -> BL.ByteString -- ^ input passed to process via stdin - -> PandocLua NumResults -pipe command args input = liftPandocLua $ do - (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input - `catch` (throwM . PandocIOError "pipe") - case ec of - ExitSuccess -> 1 <$ Lua.push output - ExitFailure n -> do - pushPipeError (PipeError (T.pack command) n output) - Lua.error + => a -> LuaFilter -> LuaE PandocError a +walkElement x f = walkInlines f x + >>= walkInlineLists f + >>= walkBlocks f + >>= walkBlockLists f + +functions :: [DocumentedFunction PandocError] +functions = + [ defun "pipe" + ### (\command args input -> do + (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input + `catch` (throwM . PandocIOError "pipe") + case ec of + ExitSuccess -> 1 <$ Lua.pushLazyByteString output + ExitFailure n -> do + pushPipeError (PipeError (T.pack command) n output) + Lua.error) + <#> parameter peekString "string" "command" "path to executable" + <#> parameter (peekList peekString) "{string,...}" "args" + "list of arguments" + <#> parameter peekLazyByteString "string" "input" + "input passed to process via stdin" + =?> "output string, or error triple" + + , defun "read" + ### (\content mformatspec -> do + let formatSpec = fromMaybe "markdown" mformatspec + res <- Lua.liftIO . runIO $ getReader formatSpec >>= \case + (TextReader r, es) -> r def{ readerExtensions = es } content + _ -> throwError $ PandocSomeError + "Only textual formats are supported" + case res of + Right pd -> return pd -- success, got a Pandoc document + Left (PandocUnknownReaderError f) -> + Lua.failLua . T.unpack $ "Unknown reader: " <> f + Left (PandocUnsupportedExtensionError e f) -> + Lua.failLua . T.unpack $ + "Extension " <> e <> " not supported for " <> f + Left e -> + throwM e) + <#> parameter peekText "string" "content" "text to parse" + <#> optionalParameter peekText "string" "formatspec" "format and extensions" + =#> functionResult pushPandoc "Pandoc" "result document" + + , sha1 + + , defun "walk_block" + ### walkElement + <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushBlock "Block" "modified Block" + + , defun "walk_inline" + ### walkElement + <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" + <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + =#> functionResult pushInline "Inline" "modified Inline" + ] data PipeError = PipeError { pipeErrorCommand :: T.Text @@ -416,12 +481,3 @@ pushPipeError pipeErr = do , if output == mempty then BSL.pack "" else output ] return (NumResults 1) - -mkPandoc :: PandocLua NumResults -mkPandoc = liftPandocLua $ do - doc <- forcePeek $ do - blks <- peekBlocksFuzzy (nthBottom 1) - mMeta <- optional $ peekMeta (nthBottom 2) - pure $ Pandoc (fromMaybe nullMeta mMeta) blks - pushPandoc doc - return 1 diff --git a/src/Text/Pandoc/Lua/Module/System.hs b/src/Text/Pandoc/Lua/Module/System.hs index 8589f672c..e329a0125 100644 --- a/src/Text/Pandoc/Lua/Module/System.hs +++ b/src/Text/Pandoc/Lua/Module/System.hs @@ -11,34 +11,28 @@ Pandoc's system Lua module. -} module Text.Pandoc.Lua.Module.System - ( pushModule + ( documentedModule ) where -import HsLua hiding (pushModule) +import HsLua import HsLua.Module.System (arch, env, getwd, os, with_env, with_tmpdir, with_wd) -import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.ErrorConversion () - -import qualified HsLua as Lua -- | Push the pandoc.system module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.pushModule $ Module - { moduleName = "system" - , moduleDescription = "system functions" - , moduleFields = - [ arch - , os - ] - , moduleFunctions = - [ setName "environment" env - , setName "get_working_directory" getwd - , setName "with_environment" with_env - , setName "with_temporary_directory" with_tmpdir - , setName "with_working_directory" with_wd - ] - , moduleOperations = [] - } - return 1 +documentedModule :: LuaError e => Module e +documentedModule = Module + { moduleName = "pandoc.system" + , moduleDescription = "system functions" + , moduleFields = + [ arch + , os + ] + , moduleFunctions = + [ setName "environment" env + , setName "get_working_directory" getwd + , setName "with_environment" with_env + , setName "with_temporary_directory" with_tmpdir + , setName "with_working_directory" with_wd + ] + , moduleOperations = [] + } diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index ff4a4e0d5..4b37dafd9 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -10,34 +10,52 @@ Pandoc data type constructors. -} module Text.Pandoc.Lua.Module.Types - ( pushModule + ( documentedModule ) where -import HsLua (LuaE, NumResults, Peeker, Pusher) +import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) + , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Util (addFunction) import qualified HsLua as Lua -import qualified HsLua.Module.Version as Version -- | Push the pandoc.types module on the Lua stack. -pushModule :: LuaE PandocError NumResults -pushModule = do - Lua.newtable - Lua.pushName "Version" *> Lua.pushModule Version.documentedModule - *> Lua.rawset (Lua.nth 3) - pushCloneTable - Lua.setfield (Lua.nth 2) "clone" - return 1 - -pushCloneTable :: LuaE PandocError NumResults -pushCloneTable = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta Lua.push - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - return 1 +documentedModule :: Module PandocError +documentedModule = Module + { moduleName = "pandoc.types" + , moduleDescription = + "Constructors for types that are not part of the pandoc AST." + , moduleFields = + [ Field + { fieldName = "clone" + , fieldDescription = "DEPRECATED! Helper functions for element cloning." + , fieldPushValue = do + Lua.newtable + addFunction "Meta" $ cloneWith peekMeta pushMeta + addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue + } + ] + , moduleFunctions = + [ defun "Version" + ### return + <#> parameter peekVersionFuzzy "string|integer|{integer,...}|Version" + "version_specifier" + (mconcat [ "either a version string like `'2.7.3'`, " + , "a single integer like `2`, " + , "list of integers like `{2,7,3}`, " + , "or a Version object" + ]) + =#> functionResult pushVersion "Version" "A new Version object." + ] + , moduleOperations = [] + } + where addFunction name fn = do + Lua.pushName name + Lua.pushHaskellFunction fn + Lua.rawset (Lua.nth 3) cloneWith :: Peeker PandocError a -> Pusher PandocError a diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 3602612cb..01ba4eb46 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -13,7 +13,8 @@ Utility module for Lua, exposing internal helper functions. -} module Text.Pandoc.Lua.Module.Utils - ( pushModule + ( documentedModule + , sha1 ) where import Control.Applicative ((<|>)) @@ -21,7 +22,7 @@ import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Default (def) import Data.Version (Version) -import HsLua as Lua hiding (pushModule) +import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition @@ -39,7 +40,6 @@ import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T -import qualified HsLua.Packaging as Lua import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter import qualified Text.Pandoc.Shared as Shared @@ -47,8 +47,8 @@ import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.Writers.Shared as Shared -- | Push the "pandoc.utils" module to the Lua stack. -pandocUtilsModule :: Module PandocError -pandocUtilsModule = Module +documentedModule :: Module PandocError +documentedModule = Module { moduleName = "pandoc.utils" , moduleDescription = "pandoc utility functions" , moduleFields = [] @@ -92,12 +92,7 @@ pandocUtilsModule = Module , "Returns nil instead of a string if the conversion failed." ] - , defun "sha1" - ### liftPure (SHA.showDigest . SHA.sha1) - <#> parameter (fmap BSL.fromStrict . peekByteString) "string" - "input" "" - =#> functionResult pushString "string" "hexadecimal hash value" - #? "Compute the hash of the given string value." + , sha1 , defun "Version" ### liftPure (id @Version) @@ -146,8 +141,13 @@ pandocUtilsModule = Module ] } -pushModule :: LuaE PandocError NumResults -pushModule = 1 <$ Lua.pushModule pandocUtilsModule +-- | Documented Lua function to compute the hash of a string. +sha1 :: DocumentedFunction e +sha1 = defun "sha1" + ### liftPure (SHA.showDigest . SHA.sha1) + <#> parameter (fmap BSL.fromStrict . peekByteString) "string" "input" "" + =#> functionResult pushString "string" "hexadecimal hash value" + #? "Compute the hash of the given string value." -- | Convert pandoc structure to a string with formatting removed. diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index f9bd7abe8..8e5cc96c3 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -16,7 +16,6 @@ module Text.Pandoc.Lua.Packages ) where import Control.Monad (forM_) -import HsLua (NumResults) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) @@ -43,24 +42,27 @@ installPandocPackageSearcher = liftPandocLua $ do Lua.rawseti (-2) (i + 1) -- | Load a pandoc module. -pandocPackageSearcher :: String -> PandocLua NumResults +pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule - "pandoc.mediabag" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError MediaBag.pushModule - "pandoc.path" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Path.documentedModule) - "pandoc.system" -> pushWrappedHsFun $ Lua.toHaskellFunction System.pushModule - "pandoc.types" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Types.pushModule - "pandoc.utils" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Utils.pushModule - "text" -> pushWrappedHsFun - (Lua.NumResults 1 <$ Lua.pushModule @PandocError Text.documentedModule) - "pandoc.List" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError (loadDefaultModule pkgName) + "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule + "pandoc.path" -> pushModuleLoader Path.documentedModule + "pandoc.system" -> pushModuleLoader System.documentedModule + "pandoc.types" -> pushModuleLoader Types.documentedModule + "pandoc.utils" -> pushModuleLoader Utils.documentedModule + "text" -> pushModuleLoader Text.documentedModule + "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ + loadDefaultModule pkgName _ -> reportPandocSearcherFailure where + pushModuleLoader mdl = liftPandocLua $ do + Lua.pushHaskellFunction $ + Lua.NumResults 1 <$ Lua.pushModule @PandocError mdl + return (Lua.NumResults 1) pushWrappedHsFun f = liftPandocLua $ do Lua.pushHaskellFunction f return 1 reportPandocSearcherFailure = liftPandocLua $ do Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages") - return (1 :: NumResults) + return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 12511d088..6c2ebc622 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,7 +22,6 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , addFunction , loadDefaultModule ) where @@ -76,13 +75,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Add a function to the table at the top of the stack, using the given name. -addFunction :: Exposable PandocError a => Name -> a -> PandocLua () -addFunction name fn = liftPandocLua $ do - Lua.pushName name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Load a pure Lua module included with pandoc. Leaves the result on -- the stack and returns @NumResults 1@. -- diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f20bc09e8..f35201db0 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -18,7 +18,6 @@ Lua utility functions. module Text.Pandoc.Lua.Util ( getTag , addField - , addFunction , callWithTraceback , dofileWithTraceback , pushViaConstr' @@ -35,14 +34,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Add a function to the table at the top of the stack, using the --- given name. -addFunction :: Exposable e a => String -> a -> LuaE e () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction $ toHaskellFunction fn - Lua.rawset (-3) - -- | Get the tag of a value. This is an optimized and specialized version of -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index -- @idx@ and on its metatable, also ignoring any @__index@ value on the diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 72446db99..6e8257633 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -408,6 +408,12 @@ return { }) assert.are_same(expected, pandoc.read(valid_markdown)) end), + test('unsupported extension', function () + assert.error_matches( + function () pandoc.read('foo', 'gfm+empty_paragraphs') end, + 'Extension empty_paragraphs not supported for gfm' + ) + end), test('failing read', function () assert.error_matches( function () pandoc.read('foo', 'nosuchreader') end, -- cgit v1.2.3 From bffd74323cfd91f5c44ca34e09633247d1d28954 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 23 Nov 2021 18:32:53 +0100 Subject: Lua: add function `pandoc.utils.text` (#7710) The function converts a string to `Inlines`, treating interword spaces as `Space`s or `SoftBreak`s. If you want a `Str` with literal spaces, use `pandoc.Str`. Closes: #7709 --- doc/lua-filters.md | 18 ++++++++++++++++++ src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 + src/Text/Pandoc/Lua/Module/Utils.hs | 12 ++++++++++-- test/lua/module/pandoc-utils.lua | 28 ++++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 9fc90a13f..db5d1ccac 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3082,6 +3082,24 @@ Usage: -- outputs "Moin" print(pandoc.utils.stringify(inline)) +### text {#pandoc.utils.text} + +`text (words)` + +Converts a string to `Inlines`, treating interword spaces as +`Space`s or `SoftBreak`s. If you want a single `Str` with literal +spaces, use `pandoc.Str`. + +Parameters: + +`words` +: markup-less text (string) + +Returns: + +- List of inline elements split into words (Inlines) + + ### to\_roman\_numeral {#pandoc.utils.to_roman_numeral} `to_roman_numeral (integer)` diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 31d040c83..9cf683055 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -44,6 +44,7 @@ module Text.Pandoc.Lua.Marshaling.AST , pushBlock , pushCitation , pushInline + , pushInlines , pushListAttributes , pushMeta , pushMetaValue diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 01ba4eb46..6fd707bf8 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -29,8 +29,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshaling () import Text.Pandoc.Lua.Marshaling.AST - ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushPandoc - , peekAttr, peekMeta, peekMetaValue) + ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines + , pushPandoc, peekAttr, peekMeta, peekMetaValue) import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) import Text.Pandoc.Lua.Marshaling.List (pushPandocList) import Text.Pandoc.Lua.Marshaling.SimpleTable @@ -122,6 +122,14 @@ documentedModule = Module <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" + , defun "text" + ### liftPure (B.toList . B.text) + <#> parameter peekText "string" "words" "markup-less inlines text" + =#> functionResult pushInlines "Inlines" "list of inline elements" + #? ("Converts a string to `Inlines`, treating interword spaces as " <> + "`Space`s or `SoftBreak`s. If you want a `Str` with literal " <> + "spaces, use `pandoc.Str`.") + , defun "from_simple_table" ### from_simple_table <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" "" diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 9bd903f2d..21f550177 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -82,6 +82,34 @@ return { end) }, + group 'text' { + test('string is converted to inlines', function () + local expected = { + pandoc.Str 'Madness', pandoc.Space(), pandoc.Str '-', pandoc.Space(), + pandoc.Str 'Our', pandoc.Space(), pandoc.Str 'House' + } + assert.are_same(pandoc.utils.text('Madness - Our House'), expected) + end), + test('tabs are treated as space', function () + local expected = { + pandoc.Str 'Linkin', pandoc.Space(), pandoc.Str 'Park', pandoc.Space(), + pandoc.Str '-', pandoc.Space(), pandoc.Str 'Papercut' + } + assert.are_same(pandoc.utils.text('Linkin Park\t-\tPapercut'), expected) + end), + test('newlines are treated as softbreaks', function () + local expected = { + pandoc.Str 'Porcupine', pandoc.Space(), pandoc.Str 'Tree', + pandoc.SoftBreak(), pandoc.Str '-', pandoc.SoftBreak(), + pandoc.Str 'Blackest', pandoc.Space(), pandoc.Str 'Eyes' + } + assert.are_same( + pandoc.utils.text('Porcupine Tree\n-\nBlackest Eyes'), + expected + ) + end), + }, + group 'to_roman_numeral' { test('convertes number', function () assert.are_equal('MDCCCLXXXVIII', utils.to_roman_numeral(1888)) -- cgit v1.2.3 From 3692a1d1e83703fbf235214f2838cd92683c625c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 28 Nov 2021 02:08:01 +0100 Subject: Lua: use package pandoc-lua-marshal (#7719) The marshaling functions for pandoc's AST are extracted into a separate package. The package comes with a number of changes: - Pandoc's List module was rewritten in C, thereby improving error messages. - Lists of `Block` and `Inline` elements are marshaled using the new list types `Blocks` and `Inlines`, respectively. These types currently behave identical to the generic List type, but give better error messages. This also opens up the possibility of adding element-specific methods to these lists in the future. - Elements of type `MetaValue` are no longer pushed as values which have `.t` and `.tag` properties. This was already true for `MetaString` and `MetaBool` values, which are still marshaled as Lua strings and booleans, respectively. Affected values: + `MetaBlocks` values are marshaled as a `Blocks` list; + `MetaInlines` values are marshaled as a `Inlines` list; + `MetaList` values are marshaled as a generic pandoc `List`s. + `MetaMap` values are marshaled as plain tables and no longer given any metatable. - The test suite for marshaled objects and their constructors has been extended and improved. - A bug in Citation objects, where setting a citation's suffix modified it's prefix, has been fixed. --- cabal.project | 5 + data/pandoc.List.lua | 142 ---- data/pandoc.lua | 247 ------- pandoc.cabal | 20 +- src/Text/Pandoc/Lua.hs | 2 +- src/Text/Pandoc/Lua/ErrorConversion.hs | 2 +- src/Text/Pandoc/Lua/Filter.hs | 13 +- src/Text/Pandoc/Lua/Global.hs | 6 +- src/Text/Pandoc/Lua/Init.hs | 50 +- src/Text/Pandoc/Lua/Marshal/CommonState.hs | 70 ++ src/Text/Pandoc/Lua/Marshal/Context.hs | 28 + src/Text/Pandoc/Lua/Marshal/PandocError.hs | 51 ++ src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs | 133 ++++ src/Text/Pandoc/Lua/Marshaling.hs | 19 - src/Text/Pandoc/Lua/Marshaling/AST.hs | 868 ----------------------- src/Text/Pandoc/Lua/Marshaling/Attr.hs | 237 ------- src/Text/Pandoc/Lua/Marshaling/CommonState.hs | 70 -- src/Text/Pandoc/Lua/Marshaling/Context.hs | 28 - src/Text/Pandoc/Lua/Marshaling/List.hs | 48 -- src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs | 72 -- src/Text/Pandoc/Lua/Marshaling/PandocError.hs | 51 -- src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs | 133 ---- src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs | 92 --- src/Text/Pandoc/Lua/Module/MediaBag.hs | 4 +- src/Text/Pandoc/Lua/Module/Pandoc.hs | 261 +------ src/Text/Pandoc/Lua/Module/Types.hs | 30 +- src/Text/Pandoc/Lua/Module/Utils.hs | 9 +- src/Text/Pandoc/Lua/Orphans.hs | 111 +++ src/Text/Pandoc/Lua/Packages.hs | 7 +- src/Text/Pandoc/Lua/PandocLua.hs | 25 +- src/Text/Pandoc/Lua/Util.hs | 31 +- src/Text/Pandoc/Lua/Walk.hs | 31 +- stack.yaml | 4 +- test/Tests/Lua.hs | 3 +- test/lua/module/pandoc.lua | 844 +++------------------- 35 files changed, 581 insertions(+), 3166 deletions(-) delete mode 100644 data/pandoc.List.lua delete mode 100644 data/pandoc.lua create mode 100644 src/Text/Pandoc/Lua/Marshal/CommonState.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/Context.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/PandocError.hs create mode 100644 src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/AST.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/Attr.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/CommonState.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/Context.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/List.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/PandocError.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs delete mode 100644 src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs create mode 100644 src/Text/Pandoc/Lua/Orphans.hs (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/cabal.project b/cabal.project index 669dd74e2..7164f9978 100644 --- a/cabal.project +++ b/cabal.project @@ -3,6 +3,11 @@ tests: True flags: +embed_data_files constraints: aeson >= 2.0.1.0 +source-repository-package + type: git + location: https://github.com/tarleb/pandoc-lua-marshal.git + tag: 56387e543c48cc5518a77c2a271ff211653f2a36 + -- source-repository-package -- type: git -- location: https://github.com/jgm/texmath.git diff --git a/data/pandoc.List.lua b/data/pandoc.List.lua deleted file mode 100644 index b33c30876..000000000 --- a/data/pandoc.List.lua +++ /dev/null @@ -1,142 +0,0 @@ ---[[ -List.lua - -Copyright © 2017–2020 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ]] - ---- Pandoc's List type and helper methods --- @classmod pandoc.List --- @author Albert Krewinkel --- @copyright © 2017–2020 Albert Krewinkel --- @license MIT -local List = { - _VERSION = "1.0.0" -} - ---- Create a new list. --- @param[opt] o table that should be altered into a list (default: `{}`) --- @return the altered input table -function List:new (o) - o = o or {} - setmetatable(o, self) - self.__index = self - return o -end - ---- Concatenates two lists. --- @param list second list concatenated to the first --- @return a new list containing all elements from list1 and list2 -function List:__concat (list) - local res = List.clone(self) - List.extend(res, list) - return res -end - ---- Returns a (shallow) copy of the list. -function List:clone () - local lst = setmetatable({}, getmetatable(self)) - List.extend(lst, self) - return lst -end - ---- Adds the given list to the end of this list. --- @param list list to appended -function List:extend (list) - for i = 1, #list do - self[#self + 1] = list[i] - end -end - ---- Returns a new list containing all items satisfying a given condition. --- @param pred condition items must satisfy. --- @return a new list containing all items for which `test` was true. -function List:filter (pred) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - if pred(self[i], i) then - res[#res + 1] = self[i] - end - end - return res -end - ---- Returns the value and index of the first occurrence of the given item. --- @param needle item to search for --- @param[opt] init index at which the search is started (default: 1) --- @return first item equal to the needle, or nil if no such item exists. --- @return index of that element -function List:find (needle, init) - return List.find_if(self, function(x) return x == needle end, init) -end - ---- Returns the value and index of the first element for which the predicate ---- holds true. --- @param pred the predicate function --- @param[opt] init index at which the search is started (default: 1) --- @return first item for which `test` succeeds, or nil if no such item exists. --- @return index of that element -function List:find_if (pred, init) - init = (init == nil and 1) or (init < 0 and #self - init) or init - for i = init, #self do - if pred(self[i], i) then - return self[i], i - end - end - return nil -end - ---- Checks if the list has an item equal to the given needle. --- @param needle item to search for --- @param[opt] init index at which the search is started; defaults to 1. --- @return true if a list item is equal to the needle, false otherwise -function List:includes (needle, init) - return not (List.find(self, needle, init) == nil) -end - ---- Insert an element into the list. Alias for `table.insert`. --- @param list list --- @param[opt] pos position at which the new element is to be inserted --- @param value value to insert -List.insert = table.insert - ---- Returns a copy of the current list by applying the given function to --- all elements. --- @param fn function which is applied to all list items. -function List:map (fn) - local res = setmetatable({}, getmetatable(self)) - for i = 1, #self do - res[i] = fn(self[i], i) - end - return res -end - ---- Remove element from list (alias for `table.remove`) --- @param list list --- @param[opt] pos position of the element to be removed (default: #list) --- @return the removed element -List.remove = table.remove - ---- Sort list in-place (alias for `table.sort`) --- @param list list --- @param[opt] comp comparison function; default to `<` operator. -List.sort = table.sort - --- Set metatable with __call metamethod. This allows the use of `List` --- as a constructor function. -local ListMT = { - __call = List.new -} -setmetatable(List, ListMT) - -return List diff --git a/data/pandoc.lua b/data/pandoc.lua deleted file mode 100644 index 7e5ff799b..000000000 --- a/data/pandoc.lua +++ /dev/null @@ -1,247 +0,0 @@ ---[[ -pandoc.lua - -Copyright © 2017–2019 Albert Krewinkel - -Permission to use, copy, modify, and/or distribute this software for any purpose -with or without fee is hereby granted, provided that the above copyright notice -and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH -REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, -INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER -TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF -THIS SOFTWARE. -]] - ---- --- Lua functions for pandoc scripts. --- --- @author Albert Krewinkel --- @copyright © 2017–2019 Albert Krewinkel --- @license MIT -local M = {} - --- Re-export bundled modules -M.List = require 'pandoc.List' -M.mediabag = require 'pandoc.mediabag' -M.path = require 'pandoc.path' -M.system = require 'pandoc.system' -M.types = require 'pandoc.types' -M.utils = require 'pandoc.utils' -M.text = require 'text' - --- Local names for modules which this module depends on. -local List = M.List -local utils = M.utils - - ------------------------------------------------------------------------- --- Accessor objects --- --- Create metatables which allow to access numerical indices via accessor --- methods. --- @section --- @local - ---- Create a new table which allows to access numerical indices via accessor --- functions. --- @local -local function create_accessor_behavior (tag) - local behavior = {tag = tag} - behavior.__eq = utils.equals - behavior.__index = function(t, k) - if k == "t" then - return getmetatable(t)["tag"] - end - return getmetatable(t)[k] - end - behavior.__pairs = function (t) - return next, t - end - return behavior -end - - ------------------------------------------------------------------------- --- The base class for types --- @type Type --- @local -local Type = {} -Type.name = 'Type' -Type.__index = Type -Type.behavior = { - __type = Type, - new = function (obj) - obj = obj or {} - setmetatable(obj, self) - return obj - end -} -Type.behavior.__index = Type.behavior - ---- Set a new behavior for the type, inheriting that of the parent type if none ---- is specified explicitly --- @param behavior the behavior object for this type. --- @local -function Type:set_behavior (behavior) - behavior = behavior or {} - behavior.__index = rawget(behavior, '__index') or behavior - behavior.__type = self - if not getmetatable(behavior) and getmetatable(self) then - setmetatable(behavior, getmetatable(self).behavior) - end - self.behavior = behavior -end - ---- Create a new subtype, using the given table as base. --- @param name name of the new type --- @param[opt] behavior behavioral object for the new type. --- @return a new type --- @local -function Type:make_subtype(name, behavior) - local newtype = setmetatable({}, self) - newtype.name = name - newtype.__index = newtype - newtype:set_behavior(behavior) - return newtype -end - - ------------------------------------------------------------------------- --- The base class for pandoc's AST elements. --- @type AstElement --- @local -local AstElement = Type:make_subtype 'AstElement' -AstElement.__call = function(t, ...) - local success, ret = pcall(t.new, t, ...) - if success then - return setmetatable(ret, t.behavior) - else - error(string.format('Constructor for %s failed: %s\n', t.name, ret)) - end -end - ---- Make a new subtype which constructs a new value when called. --- @local -function AstElement:make_subtype(...) - local newtype = Type.make_subtype(self, ...) - newtype.__call = self.__call - return newtype -end - ---- Create a new constructor --- @local --- @param tag Tag used to identify the constructor --- @param fn Function to be called when constructing a new element --- @param accessors names to use as accessors for numerical fields --- @return function that constructs a new element -function AstElement:create_constructor(tag, fn) - local constr = self:make_subtype(tag, create_accessor_behavior(tag)) - function constr:new(...) - return setmetatable(fn(...), self.behavior) - end - self.constructor = self.constructor or {} - self.constructor[tag] = constr - return constr -end - ---- Convert AstElement input into a list if necessary. --- @local -local function ensureList (x) - if x.tag then - -- Lists are not tagged, but all elements are - return List:new{x} - else - return List:new(x) - end -end - ---- Ensure a given object is an Inline element, or convert it into one. --- @local -local function ensureInlineList (x) - if type(x) == 'string' then - return List:new{M.Str(x)} - else - return ensureList(x) - end -end - ------------------------------------------------------------------------- --- Meta --- @section Meta - ---- Create a new Meta object. It sets the metatable of the given table to ---- `Meta`. --- @function Meta --- @tparam meta table table containing document meta information -M.Meta = AstElement:make_subtype'Meta' -M.Meta.behavior.clone = M.types.clone.Meta -function M.Meta:new (meta) return meta end - - ------------------------------------------------------------------------- --- MetaValue --- @section MetaValue -M.MetaValue = AstElement:make_subtype('MetaValue') -M.MetaValue.behavior.clone = M.types.clone.MetaValue - ---- Meta blocks --- @function MetaBlocks --- @tparam {Block,...} blocks blocks -M.MetaBlocks = M.MetaValue:create_constructor( - 'MetaBlocks', - function (content) return ensureList(content) end -) - ---- Meta inlines --- @function MetaInlines --- @tparam {Inline,...} inlines inlines -M.MetaInlines = M.MetaValue:create_constructor( - 'MetaInlines', - function (content) return ensureInlineList(content) end -) - ---- Meta list --- @function MetaList --- @tparam {MetaValue,...} meta_values list of meta values -M.MetaList = M.MetaValue:create_constructor( - 'MetaList', - function (content) - if content.tag == 'MetaList' then - return content - end - return ensureList(content) - end -) -for k, v in pairs(List) do - M.MetaList.behavior[k] = v -end - ---- Meta map --- @function MetaMap --- @tparam table key_value_map a string-indexed map of meta values -M.MetaMap = M.MetaValue:create_constructor( - "MetaMap", - function (mm) return mm end -) - ---- Creates string to be used in meta data. --- Does nothing, lua strings are meta strings. --- @function MetaString --- @tparam string str string value -function M.MetaString(str) - return str -end - ---- Creates boolean to be used in meta data. --- Does nothing, lua booleans are meta booleans. --- @function MetaBool --- @tparam boolean bool boolean value -function M.MetaBool(bool) - return bool -end - -return M diff --git a/pandoc.cabal b/pandoc.cabal index 99962ac4c..e7d1349fc 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -177,10 +177,6 @@ data-files: data/creole.lua -- lua init script data/init.lua - -- pandoc lua module - data/pandoc.lua - -- lua List module - data/pandoc.List.lua -- bash completion template data/bash_completion.tpl -- citeproc @@ -481,6 +477,7 @@ library mtl >= 2.2 && < 2.3, network >= 2.6, network-uri >= 2.6 && < 2.8, + pandoc-lua-marshal >= 0.1 && < 0.2, pandoc-types >= 1.22.1 && < 1.23, parsec >= 3.1 && < 3.2, pretty >= 1.1 && < 1.2, @@ -689,21 +686,16 @@ library Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.Global, Text.Pandoc.Lua.Init, - Text.Pandoc.Lua.Marshaling, - Text.Pandoc.Lua.Marshaling.AST, - Text.Pandoc.Lua.Marshaling.Attr, - Text.Pandoc.Lua.Marshaling.CommonState, - Text.Pandoc.Lua.Marshaling.Context, - Text.Pandoc.Lua.Marshaling.List, - Text.Pandoc.Lua.Marshaling.ListAttributes, - Text.Pandoc.Lua.Marshaling.PandocError, - Text.Pandoc.Lua.Marshaling.ReaderOptions, - Text.Pandoc.Lua.Marshaling.SimpleTable, + Text.Pandoc.Lua.Marshal.CommonState, + Text.Pandoc.Lua.Marshal.Context, + Text.Pandoc.Lua.Marshal.PandocError, + Text.Pandoc.Lua.Marshal.ReaderOptions, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, Text.Pandoc.Lua.Module.System, Text.Pandoc.Lua.Module.Types, Text.Pandoc.Lua.Module.Utils, + Text.Pandoc.Lua.Orphans, Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocLua, Text.Pandoc.Lua.Util, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index f0e9e076b..2aa84b7fa 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -20,4 +20,4 @@ module Text.Pandoc.Lua import Text.Pandoc.Lua.Filter (runFilterFile) import Text.Pandoc.Lua.Global (Global (..), setGlobals) import Text.Pandoc.Lua.Init (runLua) -import Text.Pandoc.Lua.Marshaling () +import Text.Pandoc.Lua.Orphans () diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs index 9c4c990a3..5cb1bf825 100644 --- a/src/Text/Pandoc/Lua/ErrorConversion.hs +++ b/src/Text/Pandoc/Lua/ErrorConversion.hs @@ -19,7 +19,7 @@ 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.Marshaling.PandocError (pushPandocError, peekPandocError) +import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError) import qualified Data.Text as T import qualified HsLua as Lua diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 9fd0ef32c..ba5a14a0d 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -33,10 +33,9 @@ import Data.String (IsString (fromString)) import HsLua as Lua import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List (List (..), peekList') -import Text.Pandoc.Lua.Walk (SingletonsList (..)) +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Walk (List (..), SingletonsList (..)) import Text.Pandoc.Walk (Walkable (walkM)) import qualified Data.Map.Strict as Map @@ -196,7 +195,8 @@ walkInlineLists :: Walkable (List Inline) a => LuaFilter -> a -> LuaE PandocError a walkInlineLists lf = let f :: List Inline -> LuaE PandocError (List Inline) - f = runOnValue listOfInlinesFilterName (peekList' peekInline) lf + f = runOnValue listOfInlinesFilterName peekListOfInlines lf + peekListOfInlines idx = List <$!> (peekInlinesFuzzy idx) in if lf `contains` listOfInlinesFilterName then walkM f else return @@ -214,7 +214,8 @@ walkBlockLists :: Walkable (List Block) a => LuaFilter -> a -> LuaE PandocError a walkBlockLists lf = let f :: List Block -> LuaE PandocError (List Block) - f = runOnValue listOfBlocksFilterName (peekList' peekBlock) lf + f = runOnValue listOfBlocksFilterName peekListOfBlocks lf + peekListOfBlocks idx = List <$!> (peekBlocksFuzzy idx) in if lf `contains` listOfBlocksFilterName then walkM f else return diff --git a/src/Text/Pandoc/Lua/Global.hs b/src/Text/Pandoc/Lua/Global.hs index 05510f45d..c7b50a25f 100644 --- a/src/Text/Pandoc/Lua/Global.hs +++ b/src/Text/Pandoc/Lua/Global.hs @@ -20,9 +20,9 @@ import Paths_pandoc (version) import Text.Pandoc.Class.CommonState (CommonState) import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState) -import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Marshal.CommonState (pushCommonState) +import Text.Pandoc.Lua.Marshal.ReaderOptions (pushReaderOptionsReadonly) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Options (ReaderOptions) import qualified Data.Text as Text diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index 2f113bff2..835da1fc9 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -17,7 +17,6 @@ module Text.Pandoc.Lua.Init import Control.Monad (forM, forM_, when) import Control.Monad.Catch (throwM, try) import Control.Monad.Trans (MonadIO (..)) -import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Maybe (catMaybes) import HsLua as Lua hiding (status, try) import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) @@ -27,7 +26,6 @@ import Text.Pandoc.Lua.Packages (installPandocPackageSearcher) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua) import qualified Data.Text as T import qualified Lua.LPeg as LPeg -import qualified Text.Pandoc.Definition as Pandoc import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc -- | Run the lua interpreter, using pandoc's default way of environment @@ -42,6 +40,19 @@ runLua luaOp = do liftIO $ setForeignEncoding enc return res +-- | Modules that are loaded at startup and assigned to fields in the +-- pandoc module. +loadedModules :: [(Name, Name)] +loadedModules = + [ ("pandoc.List", "List") + , ("pandoc.mediabag", "mediabag") + , ("pandoc.path", "path") + , ("pandoc.system", "system") + , ("pandoc.types", "types") + , ("pandoc.utils", "utils") + , ("text", "text") + ] + -- | Initialize the lua state with all required values initLuaState :: PandocLua () initLuaState = do @@ -61,9 +72,13 @@ initLuaState = do Lua.getfield Lua.registryindex Lua.loaded Lua.pushvalue (Lua.nth 2) Lua.setfield (Lua.nth 2) "pandoc" - Lua.pop 1 - -- copy constructors into registry - putConstructorsInRegistry + Lua.pop 1 -- remove LOADED table + -- load modules and add them to the `pandoc` module table. + liftPandocLua $ forM_ loadedModules $ \(pkgname, fieldname) -> do + Lua.getglobal "require" + Lua.pushName pkgname + Lua.call 1 1 + Lua.setfield (nth 2) fieldname -- assign module to global variable liftPandocLua $ Lua.setglobal "pandoc" @@ -122,28 +137,3 @@ initLuaState = do Lua.pushHaskellFunction $ Lua.state >>= liftIO . LPeg.lpeg_searcher Lua.rawseti (Lua.nth 2) . (+1) . fromIntegral =<< Lua.rawlen (Lua.nth 2) Lua.pop 1 -- remove 'package.searchers' from stack - --- | AST elements are marshaled via normal constructor functions in the --- @pandoc@ module. However, accessing Lua globals from Haskell is --- expensive (due to error handling). Accessing the Lua registry is much --- cheaper, which is why the constructor functions are copied into the --- Lua registry and called from there. --- --- This function expects the @pandoc@ module to be at the top of the --- stack. -putConstructorsInRegistry :: PandocLua () -putConstructorsInRegistry = liftPandocLua $ do - constrsToReg $ Pandoc.Meta mempty - constrsToReg $ Pandoc.MetaList mempty - putInReg "List" -- pandoc.List - putInReg "SimpleTable" -- helper for backward-compatible table handling - where - constrsToReg :: Data a => a -> LuaE PandocError () - constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf - - putInReg :: String -> LuaE PandocError () - putInReg name = do - Lua.push ("pandoc." ++ name) -- name in registry - Lua.push name -- in pandoc module - Lua.rawget (Lua.nth 3) - Lua.rawset Lua.registryindex diff --git a/src/Text/Pandoc/Lua/Marshal/CommonState.hs b/src/Text/Pandoc/Lua/Marshal/CommonState.hs new file mode 100644 index 000000000..a8c0e28d2 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/CommonState.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Lua.Marshal.CommonState + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + Maintainer : Albert Krewinkel + Stability : alpha + +Instances to marshal (push) and unmarshal (peek) the common state. +-} +module Text.Pandoc.Lua.Marshal.CommonState + ( typeCommonState + , peekCommonState + , pushCommonState + ) where + +import HsLua.Core +import HsLua.Marshalling +import HsLua.Packaging +import Text.Pandoc.Class (CommonState (..)) +import Text.Pandoc.Logging (LogMessage, showLogMessage) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) + +-- | Lua type used for the @CommonState@ object. +typeCommonState :: LuaError e => DocumentedType e CommonState +typeCommonState = deftype "pandoc CommonState" [] + [ readonly "input_files" "input files passed to pandoc" + (pushPandocList pushString, stInputFiles) + + , readonly "output_file" "the file to which pandoc will write" + (maybe pushnil pushString, stOutputFile) + + , readonly "log" "list of log messages" + (pushPandocList (pushUD typeLogMessage), stLog) + + , readonly "request_headers" "headers to add for HTTP requests" + (pushPandocList (pushPair pushText pushText), stRequestHeaders) + + , readonly "resource_path" + "path to search for resources like included images" + (pushPandocList pushString, stResourcePath) + + , readonly "source_url" "absolute URL + dir of 1st source file" + (maybe pushnil pushText, stSourceURL) + + , readonly "user_data_dir" "directory to search for data files" + (maybe pushnil pushString, stUserDataDir) + + , readonly "trace" "controls whether tracing messages are issued" + (pushBool, stTrace) + + , readonly "verbosity" "verbosity level" + (pushString . show, stVerbosity) + ] + +peekCommonState :: LuaError e => Peeker e CommonState +peekCommonState = peekUD typeCommonState + +pushCommonState :: LuaError e => Pusher e CommonState +pushCommonState = pushUD typeCommonState + +typeLogMessage :: LuaError e => DocumentedType e LogMessage +typeLogMessage = deftype "pandoc LogMessage" + [ operation Index $ defun "__tostring" + ### liftPure showLogMessage + <#> udparam typeLogMessage "msg" "object" + =#> functionResult pushText "string" "stringified log message" + ] + mempty -- no members diff --git a/src/Text/Pandoc/Lua/Marshal/Context.hs b/src/Text/Pandoc/Lua/Marshal/Context.hs new file mode 100644 index 000000000..17af936e1 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Context.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.Context + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshaling instance for doctemplates Context and its components. +-} +module Text.Pandoc.Lua.Marshal.Context () where + +import qualified HsLua as Lua +import HsLua (Pushable) +import Text.DocTemplates (Context(..), Val(..), TemplateTarget) +import Text.DocLayout (render) + +instance (TemplateTarget a, Pushable a) => Pushable (Context a) where + push (Context m) = Lua.push m + +instance (TemplateTarget a, Pushable a) => Pushable (Val a) where + push NullVal = Lua.push () + push (BoolVal b) = Lua.push b + push (MapVal ctx) = Lua.push ctx + push (ListVal xs) = Lua.push xs + push (SimpleVal d) = Lua.push $ render Nothing d diff --git a/src/Text/Pandoc/Lua/Marshal/PandocError.hs b/src/Text/Pandoc/Lua/Marshal/PandocError.hs new file mode 100644 index 000000000..d1c0ad4f4 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/PandocError.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{- | + Module : Text.Pandoc.Lua.Marshal.PandocError + Copyright : © 2020-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshal of @'PandocError'@ values. +-} +module Text.Pandoc.Lua.Marshal.PandocError + ( peekPandocError + , pushPandocError + , typePandocError + ) + where + +import HsLua.Core (LuaError) +import HsLua.Marshalling (Peeker, Pusher, pushString, liftLua) +import HsLua.Packaging +import Text.Pandoc.Error (PandocError (PandocLuaError)) + +import qualified HsLua as Lua +import qualified Text.Pandoc.UTF8 as UTF8 + +-- | Lua userdata type definition for PandocError. +typePandocError :: LuaError e => DocumentedType e PandocError +typePandocError = deftype "PandocError" + [ operation Tostring $ defun "__tostring" + ### liftPure (show @PandocError) + <#> udparam typePandocError "obj" "PandocError object" + =#> functionResult pushString "string" "string representation of error." + ] + mempty -- no members + +-- | Peek a @'PandocError'@ element to the Lua stack. +pushPandocError :: LuaError e => Pusher e PandocError +pushPandocError = pushUD typePandocError + +-- | Retrieve a @'PandocError'@ from the Lua stack. +peekPandocError :: LuaError e => Peeker e PandocError +peekPandocError idx = Lua.retrieving "PandocError" $ + liftLua (Lua.ltype idx) >>= \case + Lua.TypeUserdata -> peekUD typePandocError idx + _ -> do + msg <- liftLua $ Lua.state >>= \l -> Lua.liftIO (Lua.popErrorMessage l) + return $ PandocLuaError (UTF8.toText msg) diff --git a/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs new file mode 100644 index 000000000..c20770dba --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/ReaderOptions.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.ReaderOptions + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshaling instance for ReaderOptions and its components. +-} +module Text.Pandoc.Lua.Marshal.ReaderOptions + ( peekReaderOptions + , pushReaderOptions + , pushReaderOptionsReadonly + ) where + +import Data.Default (def) +import HsLua as Lua +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Options (ReaderOptions (..)) + +-- +-- Reader Options +-- + +-- | Retrieve a ReaderOptions value, either from a normal ReaderOptions +-- value, from a read-only object, or from a table with the same +-- keys as a ReaderOptions object. +peekReaderOptions :: LuaError e => Peeker e ReaderOptions +peekReaderOptions = retrieving "ReaderOptions" . \idx -> + liftLua (ltype idx) >>= \case + TypeUserdata -> choice [ peekUD typeReaderOptions + , peekUD typeReaderOptionsReadonly + ] + idx + TypeTable -> peekReaderOptionsTable idx + _ -> failPeek =<< + typeMismatchMessage "ReaderOptions userdata or table" idx + +-- | Pushes a ReaderOptions value as userdata object. +pushReaderOptions :: LuaError e => Pusher e ReaderOptions +pushReaderOptions = pushUD typeReaderOptions + +-- | Pushes a ReaderOptions object, but makes it read-only. +pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions +pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly + +-- | ReaderOptions object type for read-only values. +typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions +typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeReaderOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" + , operation Newindex $ lambda + ### (failLua "This ReaderOptions value is read-only.") + =?> "Throws an error when called, i.e., an assignment is made." + ] + readerOptionsMembers + +-- | 'ReaderOptions' object type. +typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions +typeReaderOptions = deftype "ReaderOptions" + [ operation Tostring $ lambda + ### liftPure show + <#> udparam typeReaderOptions "opts" "options to print in native format" + =#> functionResult pushString "string" "Haskell representation" + ] + readerOptionsMembers + +-- | Member properties of 'ReaderOptions' Lua values. +readerOptionsMembers :: LuaError e + => [Member e (DocumentedFunction e) ReaderOptions] +readerOptionsMembers = + [ property "abbreviations" "" + (pushSet pushText, readerAbbreviations) + (peekSet peekText, \opts x -> opts{ readerAbbreviations = x }) + , property "columns" "" + (pushIntegral, readerColumns) + (peekIntegral, \opts x -> opts{ readerColumns = x }) + , property "default_image_extension" "" + (pushText, readerDefaultImageExtension) + (peekText, \opts x -> opts{ readerDefaultImageExtension = x }) + , property "extensions" "" + (pushString . show, readerExtensions) + (peekRead, \opts x -> opts{ readerExtensions = x }) + , property "indented_code_classes" "" + (pushPandocList pushText, readerIndentedCodeClasses) + (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x }) + , property "strip_comments" "" + (pushBool, readerStripComments) + (peekBool, \opts x -> opts{ readerStripComments = x }) + , property "standalone" "" + (pushBool, readerStandalone) + (peekBool, \opts x -> opts{ readerStandalone = x }) + , property "tab_stop" "" + (pushIntegral, readerTabStop) + (peekIntegral, \opts x -> opts{ readerTabStop = x }) + , property "track_changes" "" + (pushString . show, readerTrackChanges) + (peekRead, \opts x -> opts{ readerTrackChanges = x }) + ] + +-- | Retrieves a 'ReaderOptions' object from a table on the stack, using +-- the default values for all missing fields. +-- +-- Internally, this pushes the default reader options, sets each +-- key/value pair of the table in the userdata value, then retrieves the +-- object again. This will update all fields and complain about unknown +-- keys. +peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions +peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do + liftLua $ do + absidx <- absindex idx + pushUD typeReaderOptions def + let setFields = do + next absidx >>= \case + False -> return () -- all fields were copied + True -> do + pushvalue (nth 2) *> insert (nth 2) + settable (nth 4) -- set in userdata object + setFields + pushnil -- first key + setFields + peekUD typeReaderOptions top + +instance Pushable ReaderOptions where + push = pushReaderOptions diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs deleted file mode 100644 index e217b8852..000000000 --- a/src/Text/Pandoc/Lua/Marshaling.hs +++ /dev/null @@ -1,19 +0,0 @@ -{- | - Module : Text.Pandoc.Lua.Marshaling - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Lua marshaling (pushing) and unmarshaling (peeking) instances. --} -module Text.Pandoc.Lua.Marshaling () where - -import Text.Pandoc.Lua.Marshaling.AST () -import Text.Pandoc.Lua.Marshaling.CommonState () -import Text.Pandoc.Lua.Marshaling.Context () -import Text.Pandoc.Lua.Marshaling.PandocError() -import Text.Pandoc.Lua.Marshaling.ReaderOptions () -import Text.Pandoc.Lua.ErrorConversion () diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs deleted file mode 100644 index 6a0e5d077..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ /dev/null @@ -1,868 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.AST - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.AST - ( peekAttr - , peekBlock - , peekBlockFuzzy - , peekBlocks - , peekBlocksFuzzy - , peekCaption - , peekCitation - , peekColSpec - , peekDefinitionItem - , peekFormat - , peekInline - , peekInlineFuzzy - , peekInlines - , peekInlinesFuzzy - , peekMeta - , peekMetaValue - , peekPandoc - , peekMathType - , peekQuoteType - , peekTableBody - , peekTableHead - , peekTableFoot - - , pushAttr - , pushBlock - , pushCitation - , pushInline - , pushInlines - , pushListAttributes - , pushMeta - , pushMetaValue - , pushPandoc - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad.Catch (throwM) -import Control.Monad ((<$!>)) -import Data.Data (showConstr, toConstr) -import Data.Text (Text) -import Data.Version (Version) -import HsLua hiding (Operation (Div)) -import HsLua.Module.Version (peekVersionFuzzy) -import Text.Pandoc.Definition -import Text.Pandoc.Error (PandocError (PandocLuaError)) -import Text.Pandoc.Lua.Util (pushViaConstr') -import Text.Pandoc.Lua.Marshaling.Attr (peekAttr, pushAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.ListAttributes - (peekListAttributes, pushListAttributes) - -import qualified HsLua as Lua -import qualified Text.Pandoc.Builder as B -import qualified Text.Pandoc.Lua.Util as LuaUtil - -instance Pushable Pandoc where - push = pushPandoc - -pushPandoc :: LuaError e => Pusher e Pandoc -pushPandoc = pushUD typePandoc - -peekPandoc :: LuaError e => Peeker e Pandoc -peekPandoc = retrieving "Pandoc value" . peekUD typePandoc - -typePandoc :: LuaError e => DocumentedType e Pandoc -typePandoc = deftype "Pandoc" - [ operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter (optional . peekPandoc) "doc1" "pandoc" "" - <#> parameter (optional . peekPandoc) "doc2" "pandoc" "" - =#> functionResult pushBool "boolean" "true iff the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekPandoc "Pandoc" "doc" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "blocks" "list of blocks" - (pushPandocList pushBlock, \(Pandoc _ blks) -> blks) - (peekList peekBlock, \(Pandoc m _) blks -> Pandoc m blks) - , property "meta" "document metadata" - (pushMeta, \(Pandoc meta _) -> meta) - (peekMeta, \(Pandoc _ blks) meta -> Pandoc meta blks) - ] - -instance Pushable Meta where - push = pushMeta - -pushMeta :: LuaError e => Pusher e Meta -pushMeta (Meta mmap) = pushViaConstr' "Meta" [push mmap] - -peekMeta :: LuaError e => Peeker e Meta -peekMeta idx = retrieving "Meta" $ - Meta <$!> peekMap peekText peekMetaValue idx - -instance Pushable MetaValue where - push = pushMetaValue - -instance Pushable Block where - push = pushBlock - -typeCitation :: LuaError e => DocumentedType e Citation -typeCitation = deftype "Citation" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter (optional . peekCitation) "Citation" "a" "" - <#> parameter (optional . peekCitation) "Citation" "b" "" - =#> functionResult pushBool "boolean" "true iff the citations are equal" - - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekCitation "Citation" "citation" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "id" "citation ID / key" - (pushText, citationId) - (peekText, \citation cid -> citation{ citationId = cid }) - , property "mode" "citation mode" - (pushString . show, citationMode) - (peekRead, \citation mode -> citation{ citationMode = mode }) - , property "prefix" "citation prefix" - (pushInlines, citationPrefix) - (peekInlines, \citation prefix -> citation{ citationPrefix = prefix }) - , property "suffix" "citation suffix" - (pushInlines, citationSuffix) - (peekInlines, \citation suffix -> citation{ citationPrefix = suffix }) - , property "note_num" "note number" - (pushIntegral, citationNoteNum) - (peekIntegral, \citation noteNum -> citation{ citationNoteNum = noteNum }) - , property "hash" "hash number" - (pushIntegral, citationHash) - (peekIntegral, \citation hash -> citation{ citationHash = hash }) - , method $ defun "clone" ### return <#> udparam typeCitation "obj" "" - =#> functionResult pushCitation "Citation" "copy of obj" - ] - -pushCitation :: LuaError e => Pusher e Citation -pushCitation = pushUD typeCitation - -peekCitation :: LuaError e => Peeker e Citation -peekCitation = peekUD typeCitation - -instance Pushable Alignment where - push = Lua.pushString . show - -instance Pushable CitationMode where - push = Lua.push . show - -instance Pushable Format where - push = pushFormat - -pushFormat :: LuaError e => Pusher e Format -pushFormat (Format f) = pushText f - -peekFormat :: LuaError e => Peeker e Format -peekFormat idx = Format <$!> peekText idx - -instance Pushable ListNumberDelim where - push = Lua.push . show - -instance Pushable ListNumberStyle where - push = Lua.push . show - -instance Pushable MathType where - push = Lua.push . show - -instance Pushable QuoteType where - push = pushQuoteType - -pushMathType :: LuaError e => Pusher e MathType -pushMathType = pushString . show - -peekMathType :: LuaError e => Peeker e MathType -peekMathType = peekRead - -pushQuoteType :: LuaError e => Pusher e QuoteType -pushQuoteType = pushString . show - -peekQuoteType :: LuaError e => Peeker e QuoteType -peekQuoteType = peekRead - --- | Push an meta value element to the top of the lua stack. -pushMetaValue :: LuaError e => MetaValue -> LuaE e () -pushMetaValue = \case - MetaBlocks blcks -> pushViaConstr' "MetaBlocks" [pushList pushBlock blcks] - MetaBool bool -> Lua.push bool - MetaInlines inlns -> pushViaConstr' "MetaInlines" - [pushList pushInline inlns] - MetaList metalist -> pushViaConstr' "MetaList" - [pushList pushMetaValue metalist] - MetaMap metamap -> pushViaConstr' "MetaMap" - [pushMap pushText pushMetaValue metamap] - MetaString str -> Lua.push str - --- | Interpret the value at the given stack index as meta value. -peekMetaValue :: forall e. LuaError e => Peeker e MetaValue -peekMetaValue = retrieving "MetaValue $ " . \idx -> do - -- Get the contents of an AST element. - let mkMV :: (a -> MetaValue) -> Peeker e a -> Peek e MetaValue - mkMV f p = f <$!> p idx - - peekTagged = \case - "MetaBlocks" -> mkMV MetaBlocks $ - retrieving "MetaBlocks" . peekBlocks - "MetaBool" -> mkMV MetaBool $ - retrieving "MetaBool" . peekBool - "MetaMap" -> mkMV MetaMap $ - retrieving "MetaMap" . peekMap peekText peekMetaValue - "MetaInlines" -> mkMV MetaInlines $ - retrieving "MetaInlines" . peekInlines - "MetaList" -> mkMV MetaList $ - retrieving "MetaList" . peekList peekMetaValue - "MetaString" -> mkMV MetaString $ - retrieving "MetaString" . peekText - (Name t) -> failPeek ("Unknown meta tag: " <> t) - - peekUntagged = do - -- no meta value tag given, try to guess. - len <- liftLua $ Lua.rawlen idx - if len <= 0 - then MetaMap <$!> peekMap peekText peekMetaValue idx - else (MetaInlines <$!> peekInlines idx) - <|> (MetaBlocks <$!> peekBlocks idx) - <|> (MetaList <$!> peekList peekMetaValue idx) - luatype <- liftLua $ Lua.ltype idx - case luatype of - Lua.TypeBoolean -> MetaBool <$!> peekBool idx - Lua.TypeString -> MetaString <$!> peekText idx - Lua.TypeTable -> do - optional (LuaUtil.getTag idx) >>= \case - Just tag -> peekTagged tag - Nothing -> peekUntagged - Lua.TypeUserdata -> -- Allow singleton Inline or Block elements - (MetaInlines . (:[]) <$!> peekInline idx) <|> - (MetaBlocks . (:[]) <$!> peekBlock idx) - _ -> failPeek "could not get meta value" - -typeBlock :: LuaError e => DocumentedType e Block -typeBlock = deftype "Block" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekBlockFuzzy "Block" "a" "" - <#> parameter peekBlockFuzzy "Block" "b" "" - =#> boolResult "whether the two values are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeBlock "self" "" - =#> functionResult pushString "string" "Haskell representation" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, \case - CodeBlock attr _ -> Actual attr - Div attr _ -> Actual attr - Header _ attr _ -> Actual attr - Table attr _ _ _ _ _ -> Actual attr - _ -> Absent) - (peekAttr, \case - CodeBlock _ code -> Actual . flip CodeBlock code - Div _ blks -> Actual . flip Div blks - Header lvl _ blks -> Actual . (\attr -> Header lvl attr blks) - Table _ c cs h bs f -> Actual . (\attr -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "bodies" "table bodies" - (pushPandocList pushTableBody, \case - Table _ _ _ _ bs _ -> Actual bs - _ -> Absent) - (peekList peekTableBody, \case - Table attr c cs h _ f -> Actual . (\bs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "caption" "element caption" - (pushCaption, \case {Table _ capt _ _ _ _ -> Actual capt; _ -> Absent}) - (peekCaption, \case - Table attr _ cs h bs f -> Actual . (\c -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "colspecs" "column alignments and widths" - (pushPandocList pushColSpec, \case - Table _ _ cs _ _ _ -> Actual cs - _ -> Absent) - (peekList peekColSpec, \case - Table attr c _ h bs f -> Actual . (\cs -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "content" "element content" - (pushContent, getBlockContent) - (peekContent, setBlockContent) - , possibleProperty "foot" "table foot" - (pushTableFoot, \case {Table _ _ _ _ _ f -> Actual f; _ -> Absent}) - (peekTableFoot, \case - Table attr c cs h bs _ -> Actual . (\f -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "format" "format of raw content" - (pushFormat, \case {RawBlock f _ -> Actual f; _ -> Absent}) - (peekFormat, \case - RawBlock _ txt -> Actual . (`RawBlock` txt) - _ -> const Absent) - , possibleProperty "head" "table head" - (pushTableHead, \case {Table _ _ _ h _ _ -> Actual h; _ -> Absent}) - (peekTableHead, \case - Table attr c cs _ bs f -> Actual . (\h -> Table attr c cs h bs f) - _ -> const Absent) - , possibleProperty "level" "heading level" - (pushIntegral, \case {Header lvl _ _ -> Actual lvl; _ -> Absent}) - (peekIntegral, \case - Header _ attr inlns -> Actual . \lvl -> Header lvl attr inlns - _ -> const Absent) - , possibleProperty "listAttributes" "ordered list attributes" - (pushListAttributes, \case - OrderedList listAttr _ -> Actual listAttr - _ -> Absent) - (peekListAttributes, \case - OrderedList _ content -> Actual . (`OrderedList` content) - _ -> const Absent) - , possibleProperty "text" "text contents" - (pushText, getBlockText) - (peekText, setBlockText) - - , readonly "tag" "type of Block" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - , alias "start" "ordered list start number" ["listAttributes", "start"] - , alias "style" "ordered list style" ["listAttributes", "style"] - , alias "delimiter" "numbering delimiter" ["listAttributes", "delimiter"] - - , method $ defun "clone" - ### return - <#> parameter peekBlock "Block" "block" "self" - =#> functionResult pushBlock "Block" "cloned Block" - - , method $ defun "show" - ### liftPure show - <#> parameter peekBlock "Block" "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - where - boolResult = functionResult pushBool "boolean" - -getBlockContent :: Block -> Possible Content -getBlockContent = \case - -- inline content - Para inlns -> Actual $ ContentInlines inlns - Plain inlns -> Actual $ ContentInlines inlns - Header _ _ inlns -> Actual $ ContentInlines inlns - -- inline content - BlockQuote blks -> Actual $ ContentBlocks blks - Div _ blks -> Actual $ ContentBlocks blks - -- lines content - LineBlock lns -> Actual $ ContentLines lns - -- list items content - BulletList itms -> Actual $ ContentListItems itms - OrderedList _ itms -> Actual $ ContentListItems itms - -- definition items content - DefinitionList itms -> Actual $ ContentDefItems itms - _ -> Absent - -setBlockContent :: Block -> Content -> Possible Block -setBlockContent = \case - -- inline content - Para _ -> Actual . Para . inlineContent - Plain _ -> Actual . Plain . inlineContent - Header attr lvl _ -> Actual . Header attr lvl . inlineContent - -- block content - BlockQuote _ -> Actual . BlockQuote . blockContent - Div attr _ -> Actual . Div attr . blockContent - -- lines content - LineBlock _ -> Actual . LineBlock . lineContent - -- list items content - BulletList _ -> Actual . BulletList . listItemContent - OrderedList la _ -> Actual . OrderedList la . listItemContent - -- definition items content - DefinitionList _ -> Actual . DefinitionList . defItemContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines inlns -> [Plain inlns] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - lineContent = \case - ContentLines lns -> lns - c -> throwM . PandocLuaError $ "expected list of lines, got " <> - contentTypeDescription c - defItemContent = \case - ContentDefItems itms -> itms - c -> throwM . PandocLuaError $ "expected definition items, got " <> - contentTypeDescription c - listItemContent = \case - ContentBlocks blks -> [blks] - ContentLines lns -> map ((:[]) . Plain) lns - ContentListItems itms -> itms - c -> throwM . PandocLuaError $ "expected list of items, got " <> - contentTypeDescription c - -getBlockText :: Block -> Possible Text -getBlockText = \case - CodeBlock _ lst -> Actual lst - RawBlock _ raw -> Actual raw - _ -> Absent - -setBlockText :: Block -> Text -> Possible Block -setBlockText = \case - CodeBlock attr _ -> Actual . CodeBlock attr - RawBlock f _ -> Actual . RawBlock f - _ -> const Absent - --- | Push a block element to the top of the Lua stack. -pushBlock :: forall e. LuaError e => Block -> LuaE e () -pushBlock = pushUD typeBlock - --- | Return the value at the given index as block if possible. -peekBlock :: forall e. LuaError e => Peeker e Block -peekBlock = retrieving "Block" . peekUD typeBlock - --- | Retrieves a list of Block elements. -peekBlocks :: LuaError e => Peeker e [Block] -peekBlocks = peekList peekBlock - -peekInlines :: LuaError e => Peeker e [Inline] -peekInlines = peekList peekInline - -pushInlines :: LuaError e => Pusher e [Inline] -pushInlines = pushPandocList pushInline - --- | Retrieves a single definition item from a the stack; it is expected --- to be a pair of a list of inlines and a list of list of blocks. Uses --- fuzzy parsing, i.e., tries hard to convert mismatching types into the --- expected result. -peekDefinitionItem :: LuaError e => Peeker e ([Inline], [[Block]]) -peekDefinitionItem = peekPair peekInlinesFuzzy $ choice - [ peekList peekBlocksFuzzy - , \idx -> (:[]) <$!> peekBlocksFuzzy idx - ] - --- | Push Caption element -pushCaption :: LuaError e => Caption -> LuaE e () -pushCaption (Caption shortCaption longCaption) = do - Lua.newtable - LuaUtil.addField "short" (Lua.Optional shortCaption) - LuaUtil.addField "long" longCaption - --- | Peek Caption element -peekCaption :: LuaError e => Peeker e Caption -peekCaption = retrieving "Caption" . \idx -> do - short <- optional $ peekFieldRaw peekInlines "short" idx - long <- peekFieldRaw peekBlocks "long" idx - return $! Caption short long - --- | Push a ColSpec value as a pair of Alignment and ColWidth. -pushColSpec :: LuaError e => Pusher e ColSpec -pushColSpec = pushPair (pushString . show) pushColWidth - --- | Peek a ColSpec value as a pair of Alignment and ColWidth. -peekColSpec :: LuaError e => Peeker e ColSpec -peekColSpec = peekPair peekRead peekColWidth - -peekColWidth :: LuaError e => Peeker e ColWidth -peekColWidth = retrieving "ColWidth" . \idx -> do - maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx) - --- | Push a ColWidth value by pushing the width as a plain number, or --- @nil@ for ColWidthDefault. -pushColWidth :: LuaError e => Pusher e ColWidth -pushColWidth = \case - (ColWidth w) -> Lua.push w - ColWidthDefault -> Lua.pushnil - --- | Push a table row as a pair of attr and the list of cells. -pushRow :: LuaError e => Pusher e Row -pushRow (Row attr cells) = - pushPair pushAttr (pushPandocList pushCell) (attr, cells) - --- | Push a table row from a pair of attr and the list of cells. -peekRow :: LuaError e => Peeker e Row -peekRow = ((uncurry Row) <$!>) - . retrieving "Row" - . peekPair peekAttr (peekList peekCell) - --- | Pushes a 'TableBody' value as a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -pushTableBody :: LuaError e => Pusher e TableBody -pushTableBody (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "row_head_columns" rowHeadColumns - LuaUtil.addField "head" head' - LuaUtil.addField "body" body - --- | Retrieves a 'TableBody' value from a Lua table with fields @attr@, --- @row_head_columns@, @head@, and @body@. -peekTableBody :: LuaError e => Peeker e TableBody -peekTableBody = fmap (retrieving "TableBody") - . typeChecked "table" Lua.istable - $ \idx -> TableBody - <$!> peekFieldRaw peekAttr "attr" idx - <*> peekFieldRaw ((fmap RowHeadColumns) . peekIntegral) "row_head_columns" idx - <*> peekFieldRaw (peekList peekRow) "head" idx - <*> peekFieldRaw (peekList peekRow) "body" idx - --- | Push a table head value as the pair of its Attr and rows. -pushTableHead :: LuaError e => Pusher e TableHead -pushTableHead (TableHead attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Peek a table head value from a pair of Attr and rows. -peekTableHead :: LuaError e => Peeker e TableHead -peekTableHead = ((uncurry TableHead) <$!>) - . retrieving "TableHead" - . peekPair peekAttr (peekList peekRow) - --- | Pushes a 'TableFoot' value as a pair of the Attr value and the list --- of table rows. -pushTableFoot :: LuaError e => Pusher e TableFoot -pushTableFoot (TableFoot attr rows) = - pushPair pushAttr (pushPandocList pushRow) (attr, rows) - --- | Retrieves a 'TableFoot' value from a pair containing an Attr value --- and a list of table rows. -peekTableFoot :: LuaError e => Peeker e TableFoot -peekTableFoot = ((uncurry TableFoot) <$!>) - . retrieving "TableFoot" - . peekPair peekAttr (peekList peekRow) - -instance Pushable Cell where - push = pushCell - -instance Peekable Cell where - peek = forcePeek . peekCell - --- | Push a table cell as a table with fields @attr@, @alignment@, --- @row_span@, @col_span@, and @contents@. -pushCell :: LuaError e => Cell -> LuaE e () -pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do - Lua.newtable - LuaUtil.addField "attr" attr - LuaUtil.addField "alignment" align - LuaUtil.addField "row_span" rowSpan - LuaUtil.addField "col_span" colSpan - LuaUtil.addField "contents" contents - -peekCell :: LuaError e => Peeker e Cell -peekCell = fmap (retrieving "Cell") - . typeChecked "table" Lua.istable - $ \idx -> do - attr <- peekFieldRaw peekAttr "attr" idx - algn <- peekFieldRaw peekRead "alignment" idx - rs <- RowSpan <$!> peekFieldRaw peekIntegral "row_span" idx - cs <- ColSpan <$!> peekFieldRaw peekIntegral "col_span" idx - blks <- peekFieldRaw peekBlocks "contents" idx - return $! Cell attr algn rs cs blks - -getInlineText :: Inline -> Possible Text -getInlineText = \case - Code _ lst -> Actual lst - Math _ str -> Actual str - RawInline _ raw -> Actual raw - Str s -> Actual s - _ -> Absent - -setInlineText :: Inline -> Text -> Possible Inline -setInlineText = \case - Code attr _ -> Actual . Code attr - Math mt _ -> Actual . Math mt - RawInline f _ -> Actual . RawInline f - Str _ -> Actual . Str - _ -> const Absent - --- | Helper type to represent all the different types a `content` --- attribute can have. -data Content - = ContentBlocks [Block] - | ContentInlines [Inline] - | ContentLines [[Inline]] - | ContentDefItems [([Inline], [[Block]])] - | ContentListItems [[Block]] - -contentTypeDescription :: Content -> Text -contentTypeDescription = \case - ContentBlocks {} -> "list of Block items" - ContentInlines {} -> "list of Inline items" - ContentLines {} -> "list of Inline lists (i.e., a list of lines)" - ContentDefItems {} -> "list of definition items items" - ContentListItems {} -> "list items (i.e., list of list of Block elements)" - -pushContent :: LuaError e => Pusher e Content -pushContent = \case - ContentBlocks blks -> pushPandocList pushBlock blks - ContentInlines inlns -> pushPandocList pushInline inlns - ContentLines lns -> pushPandocList (pushPandocList pushInline) lns - ContentDefItems itms -> - let pushItem = pushPair (pushPandocList pushInline) - (pushPandocList (pushPandocList pushBlock)) - in pushPandocList pushItem itms - ContentListItems itms -> - pushPandocList (pushPandocList pushBlock) itms - -peekContent :: LuaError e => Peeker e Content -peekContent idx = - (ContentInlines <$!> peekInlinesFuzzy idx) <|> - (ContentLines <$!> peekList (peekList peekInlineFuzzy) idx) <|> - (ContentBlocks <$!> peekBlocksFuzzy idx ) <|> - (ContentListItems <$!> peekList peekBlocksFuzzy idx) <|> - (ContentDefItems <$!> peekList (peekDefinitionItem) idx) - -setInlineContent :: Inline -> Content -> Possible Inline -setInlineContent = \case - -- inline content - Cite cs _ -> Actual . Cite cs . inlineContent - Emph _ -> Actual . Emph . inlineContent - Link a _ tgt -> Actual . (\inlns -> Link a inlns tgt) . inlineContent - Quoted qt _ -> Actual . Quoted qt . inlineContent - SmallCaps _ -> Actual . SmallCaps . inlineContent - Span attr _ -> Actual . Span attr . inlineContent - Strikeout _ -> Actual . Strikeout . inlineContent - Strong _ -> Actual . Strong . inlineContent - Subscript _ -> Actual . Subscript . inlineContent - Superscript _ -> Actual . Superscript . inlineContent - Underline _ -> Actual . Underline . inlineContent - -- block content - Note _ -> Actual . Note . blockContent - _ -> const Absent - where - inlineContent = \case - ContentInlines inlns -> inlns - c -> throwM . PandocLuaError $ "expected Inlines, got " <> - contentTypeDescription c - blockContent = \case - ContentBlocks blks -> blks - ContentInlines [] -> [] - c -> throwM . PandocLuaError $ "expected Blocks, got " <> - contentTypeDescription c - -getInlineContent :: Inline -> Possible Content -getInlineContent = \case - Cite _ inlns -> Actual $ ContentInlines inlns - Emph inlns -> Actual $ ContentInlines inlns - Link _ inlns _ -> Actual $ ContentInlines inlns - Quoted _ inlns -> Actual $ ContentInlines inlns - SmallCaps inlns -> Actual $ ContentInlines inlns - Span _ inlns -> Actual $ ContentInlines inlns - Strikeout inlns -> Actual $ ContentInlines inlns - Strong inlns -> Actual $ ContentInlines inlns - Subscript inlns -> Actual $ ContentInlines inlns - Superscript inlns -> Actual $ ContentInlines inlns - Underline inlns -> Actual $ ContentInlines inlns - Note blks -> Actual $ ContentBlocks blks - _ -> Absent - --- title -getInlineTitle :: Inline -> Possible Text -getInlineTitle = \case - Image _ _ (_, tit) -> Actual tit - Link _ _ (_, tit) -> Actual tit - _ -> Absent - -setInlineTitle :: Inline -> Text -> Possible Inline -setInlineTitle = \case - Image attr capt (src, _) -> Actual . Image attr capt . (src,) - Link attr capt (src, _) -> Actual . Link attr capt . (src,) - _ -> const Absent - --- attr -getInlineAttr :: Inline -> Possible Attr -getInlineAttr = \case - Code attr _ -> Actual attr - Image attr _ _ -> Actual attr - Link attr _ _ -> Actual attr - Span attr _ -> Actual attr - _ -> Absent - -setInlineAttr :: Inline -> Attr -> Possible Inline -setInlineAttr = \case - Code _ cs -> Actual . (`Code` cs) - Image _ cpt tgt -> Actual . \attr -> Image attr cpt tgt - Link _ cpt tgt -> Actual . \attr -> Link attr cpt tgt - Span _ inlns -> Actual . (`Span` inlns) - _ -> const Absent - -showInline :: LuaError e => DocumentedFunction e -showInline = defun "show" - ### liftPure (show @Inline) - <#> parameter peekInline "inline" "Inline" "Object" - =#> functionResult pushString "string" "stringified Inline" - -typeInline :: LuaError e => DocumentedType e Inline -typeInline = deftype "Inline" - [ operation Tostring showInline - , operation Eq $ defun "__eq" - ### liftPure2 (==) - <#> parameter peekInline "a" "Inline" "" - <#> parameter peekInline "b" "Inline" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ possibleProperty "attr" "element attributes" - (pushAttr, getInlineAttr) - (peekAttr, setInlineAttr) - , possibleProperty "caption" "image caption" - (pushPandocList pushInline, \case - Image _ capt _ -> Actual capt - _ -> Absent) - (peekInlinesFuzzy, \case - Image attr _ target -> Actual . (\capt -> Image attr capt target) - _ -> const Absent) - , possibleProperty "citations" "list of citations" - (pushPandocList pushCitation, \case {Cite cs _ -> Actual cs; _ -> Absent}) - (peekList peekCitation, \case - Cite _ inlns -> Actual . (`Cite` inlns) - _ -> const Absent) - , possibleProperty "content" "element contents" - (pushContent, getInlineContent) - (peekContent, setInlineContent) - , possibleProperty "format" "format of raw text" - (pushFormat, \case {RawInline fmt _ -> Actual fmt; _ -> Absent}) - (peekFormat, \case - RawInline _ txt -> Actual . (`RawInline` txt) - _ -> const Absent) - , possibleProperty "mathtype" "math rendering method" - (pushMathType, \case {Math mt _ -> Actual mt; _ -> Absent}) - (peekMathType, \case - Math _ txt -> Actual . (`Math` txt) - _ -> const Absent) - , possibleProperty "quotetype" "type of quotes (single or double)" - (pushQuoteType, \case {Quoted qt _ -> Actual qt; _ -> Absent}) - (peekQuoteType, \case - Quoted _ inlns -> Actual . (`Quoted` inlns) - _ -> const Absent) - , possibleProperty "src" "image source" - (pushText, \case - Image _ _ (src, _) -> Actual src - _ -> Absent) - (peekText, \case - Image attr capt (_, title) -> Actual . Image attr capt . (,title) - _ -> const Absent) - , possibleProperty "target" "link target URL" - (pushText, \case - Link _ _ (tgt, _) -> Actual tgt - _ -> Absent) - (peekText, \case - Link attr capt (_, title) -> Actual . Link attr capt . (,title) - _ -> const Absent) - , possibleProperty "title" "title text" - (pushText, getInlineTitle) - (peekText, setInlineTitle) - , possibleProperty "text" "text contents" - (pushText, getInlineText) - (peekText, setInlineText) - , readonly "tag" "type of Inline" - (pushString, showConstr . toConstr ) - - , alias "t" "tag" ["tag"] - , alias "c" "content" ["content"] - , alias "identifier" "element identifier" ["attr", "identifier"] - , alias "classes" "element classes" ["attr", "classes"] - , alias "attributes" "other element attributes" ["attr", "attributes"] - - , method $ defun "clone" - ### return - <#> parameter peekInline "inline" "Inline" "self" - =#> functionResult pushInline "Inline" "cloned Inline" - ] - --- | Push an inline element to the top of the lua stack. -pushInline :: forall e. LuaError e => Inline -> LuaE e () -pushInline = pushUD typeInline - --- | Return the value at the given index as inline if possible. -peekInline :: forall e. LuaError e => Peeker e Inline -peekInline = retrieving "Inline" . \idx -> peekUD typeInline idx - --- | Try extra hard to retrieve an Inline value from the stack. Treats --- bare strings as @Str@ values. -peekInlineFuzzy :: LuaError e => Peeker e Inline -peekInlineFuzzy = retrieving "Inline" . choice - [ peekUD typeInline - , \idx -> Str <$!> peekText idx - ] - --- | Try extra-hard to return the value at the given index as a list of --- inlines. -peekInlinesFuzzy :: LuaError e => Peeker e [Inline] -peekInlinesFuzzy idx = liftLua (ltype idx) >>= \case - TypeString -> B.toList . B.text <$> peekText idx - _ -> choice - [ peekList peekInlineFuzzy - , fmap pure . peekInlineFuzzy - ] idx - --- | Try extra hard to retrieve a Block value from the stack. Treats bar --- Inline elements as if they were wrapped in 'Plain'. -peekBlockFuzzy :: LuaError e => Peeker e Block -peekBlockFuzzy = choice - [ peekBlock - , (\idx -> Plain <$!> peekInlinesFuzzy idx) - ] - --- | Try extra-hard to return the value at the given index as a list of --- blocks. -peekBlocksFuzzy :: LuaError e => Peeker e [Block] -peekBlocksFuzzy = choice - [ peekList peekBlockFuzzy - , (<$!>) pure . peekBlockFuzzy - ] - --- * Orphan Instances - -instance Pushable Inline where - push = pushInline - -instance Pushable Citation where - push = pushCitation - -instance Pushable Row where - push = pushRow - -instance Pushable TableBody where - push = pushTableBody - -instance Pushable TableFoot where - push = pushTableFoot - -instance Pushable TableHead where - push = pushTableHead - --- These instances exist only for testing. It's a hack to avoid making --- the marshalling modules public. -instance Peekable Inline where - peek = forcePeek . peekInline - -instance Peekable Block where - peek = forcePeek . peekBlock - -instance Peekable Meta where - peek = forcePeek . peekMeta - -instance Peekable Pandoc where - peek = forcePeek . peekPandoc - -instance Peekable Row where - peek = forcePeek . peekRow - -instance Peekable Version where - peek = forcePeek . peekVersionFuzzy - -instance {-# OVERLAPPING #-} Peekable Attr where - peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Marshaling/Attr.hs b/src/Text/Pandoc/Lua/Marshaling/Attr.hs deleted file mode 100644 index 97e702e35..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Attr.hs +++ /dev/null @@ -1,237 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.Attr -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above - -Maintainer : Albert Krewinkel -Stability : alpha - -Marshaling/unmarshaling instances for document AST elements. --} -module Text.Pandoc.Lua.Marshaling.Attr - ( typeAttr - , peekAttr - , pushAttr - , mkAttr - , mkAttributeList - ) where - -import Control.Applicative ((<|>), optional) -import Control.Monad ((<$!>)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import HsLua -import HsLua.Marshalling.Peekers (peekIndexRaw) -import Safe (atMay) -import Text.Pandoc.Definition (Attr, nullAttr) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) - -import qualified Data.Text as T - -typeAttr :: LuaError e => DocumentedType e Attr -typeAttr = deftype "Attr" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttr "a1" "Attr" "" - <#> parameter peekAttr "a2" "Attr" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - , operation Tostring $ lambda - ### liftPure show - <#> parameter peekAttr "Attr" "attr" "" - =#> functionResult pushString "string" "native Haskell representation" - ] - [ property "identifier" "element identifier" - (pushText, \(ident,_,_) -> ident) - (peekText, \(_,cls,kv) -> (,cls,kv)) - , property "classes" "element classes" - (pushPandocList pushText, \(_,classes,_) -> classes) - (peekList peekText, \(ident,_,kv) -> (ident,,kv)) - , property "attributes" "various element attributes" - (pushAttribs, \(_,_,attribs) -> attribs) - (peekAttribs, \(ident,cls,_) -> (ident,cls,)) - , method $ defun "clone" - ### return - <#> parameter peekAttr "attr" "Attr" "" - =#> functionResult pushAttr "Attr" "new Attr element" - , readonly "tag" "element type tag (always 'Attr')" - (pushText, const "Attr") - - , alias "t" "alias for `tag`" ["tag"] - ] - -pushAttr :: LuaError e => Pusher e Attr -pushAttr = pushUD typeAttr - -peekAttribs :: LuaError e => Peeker e [(Text,Text)] -peekAttribs idx = liftLua (ltype idx) >>= \case - TypeUserdata -> peekUD typeAttributeList idx - TypeTable -> liftLua (rawlen idx) >>= \case - 0 -> peekKeyValuePairs peekText peekText idx - _ -> peekList (peekPair peekText peekText) idx - _ -> failPeek "unsupported type" - -pushAttribs :: LuaError e => Pusher e [(Text, Text)] -pushAttribs = pushUD typeAttributeList - -typeAttributeList :: LuaError e => DocumentedType e [(Text, Text)] -typeAttributeList = deftype "AttributeList" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekAttribs "a1" "AttributeList" "" - <#> parameter peekAttribs "a2" "AttributeList" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - - , operation Index $ lambda - ### liftPure2 lookupKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - =#> functionResult (maybe pushnil pushAttribute) "string|table" - "attribute value" - - , operation Newindex $ lambda - ### setKey - <#> udparam typeAttributeList "t" "attributes list" - <#> parameter peekKey "string|integer" "key" "lookup key" - <#> optionalParameter peekAttribute "string|nil" "value" "new value" - =#> [] - - , operation Len $ lambda - ### liftPure length - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushIntegral "integer" "number of attributes in list" - - , operation Pairs $ lambda - ### pushIterator (\(k, v) -> 2 <$ pushText k <* pushText v) - <#> udparam typeAttributeList "t" "attributes list" - =?> "iterator triple" - - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeAttributeList "t" "attributes list" - =#> functionResult pushString "string" "" - ] - [] - -data Key = StringKey Text | IntKey Int - -peekKey :: LuaError e => Peeker e (Maybe Key) -peekKey idx = liftLua (ltype idx) >>= \case - TypeNumber -> Just . IntKey <$!> peekIntegral idx - TypeString -> Just . StringKey <$!> peekText idx - _ -> return Nothing - -data Attribute - = AttributePair (Text, Text) - | AttributeValue Text - -pushAttribute :: LuaError e => Pusher e Attribute -pushAttribute = \case - (AttributePair kv) -> pushPair pushText pushText kv - (AttributeValue v) -> pushText v - --- | Retrieve an 'Attribute'. -peekAttribute :: LuaError e => Peeker e Attribute -peekAttribute idx = (AttributeValue <$!> peekText idx) - <|> (AttributePair <$!> peekPair peekText peekText idx) - -lookupKey :: [(Text,Text)] -> Maybe Key -> Maybe Attribute -lookupKey !kvs = \case - Just (StringKey str) -> AttributeValue <$!> lookup str kvs - Just (IntKey n) -> AttributePair <$!> atMay kvs (n - 1) - Nothing -> Nothing - -setKey :: forall e. LuaError e - => [(Text, Text)] -> Maybe Key -> Maybe Attribute - -> LuaE e () -setKey kvs mbKey mbValue = case mbKey of - Just (StringKey str) -> - case break ((== str) . fst) kvs of - (prefix, _:suffix) -> case mbValue of - Nothing -> setNew $ prefix ++ suffix - Just (AttributeValue value) -> setNew $ prefix ++ (str, value):suffix - _ -> failLua "invalid attribute value" - _ -> case mbValue of - Nothing -> return () - Just (AttributeValue value) -> setNew (kvs ++ [(str, value)]) - _ -> failLua "invalid attribute value" - Just (IntKey idx) -> - case splitAt (idx - 1) kvs of - (prefix, (k,_):suffix) -> setNew $ case mbValue of - Nothing -> prefix ++ suffix - Just (AttributePair kv) -> prefix ++ kv : suffix - Just (AttributeValue v) -> prefix ++ (k, v) : suffix - (prefix, []) -> case mbValue of - Nothing -> setNew prefix - Just (AttributePair kv) -> setNew $ prefix ++ [kv] - _ -> failLua $ "trying to set an attribute key-value pair, " - ++ "but got a single string instead." - - _ -> failLua "invalid attribute key" - where - setNew :: [(Text, Text)] -> LuaE e () - setNew new = - putuserdata (nthBottom 1) (udName @e typeAttributeList) new >>= \case - True -> return () - False -> failLua "failed to modify attributes list" - -peekAttr :: LuaError e => Peeker e Attr -peekAttr idx = retrieving "Attr" $ liftLua (ltype idx) >>= \case - TypeString -> (,[],[]) <$!> peekText idx -- treat string as ID - TypeUserdata -> peekUD typeAttr idx - TypeTable -> peekAttrTable idx - x -> liftLua . failLua $ "Cannot get Attr from " ++ show x - --- | Helper function which gets an Attr from a Lua table. -peekAttrTable :: LuaError e => Peeker e Attr -peekAttrTable idx = do - len' <- liftLua $ rawlen idx - let peekClasses = peekList peekText - if len' > 0 - then do - ident <- peekIndexRaw 1 peekText idx - classes <- fromMaybe [] <$!> optional (peekIndexRaw 2 peekClasses idx) - attribs <- fromMaybe [] <$!> optional (peekIndexRaw 3 peekAttribs idx) - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - else retrieving "HTML-like attributes" $ do - kvs <- peekKeyValuePairs peekText peekText idx - let ident = fromMaybe "" $ lookup "id" kvs - let classes = maybe [] T.words $ lookup "class" kvs - let attribs = filter ((`notElem` ["id", "class"]) . fst) kvs - return $ ident `seq` classes `seq` attribs `seq` - (ident, classes, attribs) - --- | Constructor for 'Attr'. -mkAttr :: LuaError e => DocumentedFunction e -mkAttr = defun "Attr" - ### (ltype (nthBottom 1) >>= \case - TypeString -> forcePeek $ do - mident <- optional (peekText (nthBottom 1)) - mclass <- optional (peekList peekText (nthBottom 2)) - mattribs <- optional (peekAttribs (nthBottom 3)) - return ( fromMaybe "" mident - , fromMaybe [] mclass - , fromMaybe [] mattribs) - TypeTable -> forcePeek $ peekAttrTable (nthBottom 1) - TypeUserdata -> forcePeek $ peekUD typeAttr (nthBottom 1) <|> do - attrList <- peekUD typeAttributeList (nthBottom 1) - return ("", [], attrList) - TypeNil -> pure nullAttr - TypeNone -> pure nullAttr - x -> failLua $ "Cannot create Attr from " ++ show x) - =#> functionResult pushAttr "Attr" "new Attr object" - --- | Constructor for 'AttributeList'. -mkAttributeList :: LuaError e => DocumentedFunction e -mkAttributeList = defun "AttributeList" - ### return - <#> parameter peekAttribs "table|AttributeList" "attribs" "an attribute list" - =#> functionResult (pushUD typeAttributeList) "AttributeList" - "new AttributeList object" diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs deleted file mode 100644 index 857551598..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.CommonState - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - Stability : alpha - -Instances to marshal (push) and unmarshal (peek) the common state. --} -module Text.Pandoc.Lua.Marshaling.CommonState - ( typeCommonState - , peekCommonState - , pushCommonState - ) where - -import HsLua.Core -import HsLua.Marshalling -import HsLua.Packaging -import Text.Pandoc.Class (CommonState (..)) -import Text.Pandoc.Logging (LogMessage, showLogMessage) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) - --- | Lua type used for the @CommonState@ object. -typeCommonState :: LuaError e => DocumentedType e CommonState -typeCommonState = deftype "pandoc CommonState" [] - [ readonly "input_files" "input files passed to pandoc" - (pushPandocList pushString, stInputFiles) - - , readonly "output_file" "the file to which pandoc will write" - (maybe pushnil pushString, stOutputFile) - - , readonly "log" "list of log messages" - (pushPandocList (pushUD typeLogMessage), stLog) - - , readonly "request_headers" "headers to add for HTTP requests" - (pushPandocList (pushPair pushText pushText), stRequestHeaders) - - , readonly "resource_path" - "path to search for resources like included images" - (pushPandocList pushString, stResourcePath) - - , readonly "source_url" "absolute URL + dir of 1st source file" - (maybe pushnil pushText, stSourceURL) - - , readonly "user_data_dir" "directory to search for data files" - (maybe pushnil pushString, stUserDataDir) - - , readonly "trace" "controls whether tracing messages are issued" - (pushBool, stTrace) - - , readonly "verbosity" "verbosity level" - (pushString . show, stVerbosity) - ] - -peekCommonState :: LuaError e => Peeker e CommonState -peekCommonState = peekUD typeCommonState - -pushCommonState :: LuaError e => Pusher e CommonState -pushCommonState = pushUD typeCommonState - -typeLogMessage :: LuaError e => DocumentedType e LogMessage -typeLogMessage = deftype "pandoc LogMessage" - [ operation Index $ defun "__tostring" - ### liftPure showLogMessage - <#> udparam typeLogMessage "msg" "object" - =#> functionResult pushText "string" "stringified log message" - ] - mempty -- no members diff --git a/src/Text/Pandoc/Lua/Marshaling/Context.hs b/src/Text/Pandoc/Lua/Marshaling/Context.hs deleted file mode 100644 index 8ee25565e..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/Context.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.Context - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling instance for doctemplates Context and its components. --} -module Text.Pandoc.Lua.Marshaling.Context () where - -import qualified HsLua as Lua -import HsLua (Pushable) -import Text.DocTemplates (Context(..), Val(..), TemplateTarget) -import Text.DocLayout (render) - -instance (TemplateTarget a, Pushable a) => Pushable (Context a) where - push (Context m) = Lua.push m - -instance (TemplateTarget a, Pushable a) => Pushable (Val a) where - push NullVal = Lua.push () - push (BoolVal b) = Lua.push b - push (MapVal ctx) = Lua.push ctx - push (ListVal xs) = Lua.push xs - push (SimpleVal d) = Lua.push $ render Nothing d diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs deleted file mode 100644 index 0b145d3a1..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/List.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UndecidableInstances #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.List -Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel -Stability : alpha - -Marshaling/unmarshaling instances for @pandoc.List@s. --} -module Text.Pandoc.Lua.Marshaling.List - ( List (..) - , peekList' - , pushPandocList - ) where - -import Control.Monad ((<$!>)) -import Data.Data (Data) -import HsLua (LuaError, Peeker, Pusher, Pushable (push), peekList, pushList) -import Text.Pandoc.Walk (Walkable (..)) -import Text.Pandoc.Lua.Util (pushViaConstr') - --- | List wrapper which is marshalled as @pandoc.List@. -newtype List a = List { fromList :: [a] } - deriving (Data, Eq, Show) - -instance Pushable a => Pushable (List a) where - push (List xs) = pushPandocList push xs - --- | Pushes a list as a numerical Lua table, setting a metatable that offers a --- number of convenience functions. -pushPandocList :: LuaError e => Pusher e a -> Pusher e [a] -pushPandocList pushItem xs = pushViaConstr' "List" [pushList pushItem xs] - -peekList' :: LuaError e => Peeker e a -> Peeker e (List a) -peekList' p = (List <$!>) . peekList p - --- List is just a wrapper, so we can reuse the walk instance for --- unwrapped Hasekll lists. -instance Walkable [a] b => Walkable (List a) b where - walkM f = walkM (fmap fromList . f . List) - query f = query (f . List) diff --git a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs b/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs deleted file mode 100644 index 5a6608644..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/ListAttributes.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{- | -Module : Text.Pandoc.Lua.Marshaling.ListAttributes -Copyright : © 2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel - -Marshaling/unmarshaling functions and constructor for 'ListAttributes' -values. --} -module Text.Pandoc.Lua.Marshaling.ListAttributes - ( typeListAttributes - , peekListAttributes - , pushListAttributes - , mkListAttributes - ) where - -import Data.Maybe (fromMaybe) -import HsLua -import Text.Pandoc.Definition ( ListAttributes, ListNumberStyle (DefaultStyle) - , ListNumberDelim (DefaultDelim)) - -typeListAttributes :: LuaError e => DocumentedType e ListAttributes -typeListAttributes = deftype "ListAttributes" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> parameter peekListAttributes "a" "ListAttributes" "" - <#> parameter peekListAttributes "b" "ListAttributes" "" - =#> functionResult pushBool "boolean" "whether the two are equal" - ] - [ property "start" "number of the first list item" - (pushIntegral, \(start,_,_) -> start) - (peekIntegral, \(_,style,delim) -> (,style,delim)) - , property "style" "style used for list numbering" - (pushString . show, \(_,classes,_) -> classes) - (peekRead, \(start,_,delim) -> (start,,delim)) - , property "delimiter" "delimiter of list numbers" - (pushString . show, \(_,_,delim) -> delim) - (peekRead, \(start,style,_) -> (start,style,)) - , method $ defun "clone" - ### return - <#> udparam typeListAttributes "a" "" - =#> functionResult (pushUD typeListAttributes) "ListAttributes" - "cloned ListAttributes value" - ] - --- | Pushes a 'ListAttributes' value as userdata object. -pushListAttributes :: LuaError e => Pusher e ListAttributes -pushListAttributes = pushUD typeListAttributes - --- | Retrieve a 'ListAttributes' triple, either from userdata or from a --- Lua tuple. -peekListAttributes :: LuaError e => Peeker e ListAttributes -peekListAttributes = retrieving "ListAttributes" . choice - [ peekUD typeListAttributes - , peekTriple peekIntegral peekRead peekRead - ] - --- | Constructor for a new 'ListAttributes' value. -mkListAttributes :: LuaError e => DocumentedFunction e -mkListAttributes = defun "ListAttributes" - ### liftPure3 (\mstart mstyle mdelim -> - ( fromMaybe 1 mstart - , fromMaybe DefaultStyle mstyle - , fromMaybe DefaultDelim mdelim - )) - <#> optionalParameter peekIntegral "integer" "start" "number of first item" - <#> optionalParameter peekRead "string" "style" "list numbering style" - <#> optionalParameter peekRead "string" "delimiter" "list number delimiter" - =#> functionResult pushListAttributes "ListAttributes" "new ListAttributes" - #? "Creates a new ListAttributes object." diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs deleted file mode 100644 index 6f29a5c89..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.PandocError - Copyright : © 2020-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling of @'PandocError'@ values. --} -module Text.Pandoc.Lua.Marshaling.PandocError - ( peekPandocError - , pushPandocError - , typePandocError - ) - where - -import HsLua.Core (LuaError) -import HsLua.Marshalling (Peeker, Pusher, pushString, liftLua) -import HsLua.Packaging -import Text.Pandoc.Error (PandocError (PandocLuaError)) - -import qualified HsLua as Lua -import qualified Text.Pandoc.UTF8 as UTF8 - --- | Lua userdata type definition for PandocError. -typePandocError :: LuaError e => DocumentedType e PandocError -typePandocError = deftype "PandocError" - [ operation Tostring $ defun "__tostring" - ### liftPure (show @PandocError) - <#> udparam typePandocError "obj" "PandocError object" - =#> functionResult pushString "string" "string representation of error." - ] - mempty -- no members - --- | Peek a @'PandocError'@ element to the Lua stack. -pushPandocError :: LuaError e => Pusher e PandocError -pushPandocError = pushUD typePandocError - --- | Retrieve a @'PandocError'@ from the Lua stack. -peekPandocError :: LuaError e => Peeker e PandocError -peekPandocError idx = Lua.retrieving "PandocError" $ - liftLua (Lua.ltype idx) >>= \case - Lua.TypeUserdata -> peekUD typePandocError idx - _ -> do - msg <- liftLua $ Lua.state >>= \l -> Lua.liftIO (Lua.popErrorMessage l) - return $ PandocLuaError (UTF8.toText msg) diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs deleted file mode 100644 index 91eb22ae9..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.ReaderOptions - Copyright : © 2012-2021 John MacFarlane - © 2017-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - - Maintainer : Albert Krewinkel - Stability : alpha - -Marshaling instance for ReaderOptions and its components. --} -module Text.Pandoc.Lua.Marshaling.ReaderOptions - ( peekReaderOptions - , pushReaderOptions - , pushReaderOptionsReadonly - ) where - -import Data.Default (def) -import HsLua as Lua -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Options (ReaderOptions (..)) - --- --- Reader Options --- - --- | Retrieve a ReaderOptions value, either from a normal ReaderOptions --- value, from a read-only object, or from a table with the same --- keys as a ReaderOptions object. -peekReaderOptions :: LuaError e => Peeker e ReaderOptions -peekReaderOptions = retrieving "ReaderOptions" . \idx -> - liftLua (ltype idx) >>= \case - TypeUserdata -> choice [ peekUD typeReaderOptions - , peekUD typeReaderOptionsReadonly - ] - idx - TypeTable -> peekReaderOptionsTable idx - _ -> failPeek =<< - typeMismatchMessage "ReaderOptions userdata or table" idx - --- | Pushes a ReaderOptions value as userdata object. -pushReaderOptions :: LuaError e => Pusher e ReaderOptions -pushReaderOptions = pushUD typeReaderOptions - --- | Pushes a ReaderOptions object, but makes it read-only. -pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions -pushReaderOptionsReadonly = pushUD typeReaderOptionsReadonly - --- | ReaderOptions object type for read-only values. -typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions -typeReaderOptionsReadonly = deftype "ReaderOptions (read-only)" - [ operation Tostring $ lambda - ### liftPure show - <#> udparam typeReaderOptions "opts" "options to print in native format" - =#> functionResult pushString "string" "Haskell representation" - , operation Newindex $ lambda - ### (failLua "This ReaderOptions value is read-only.") - =?> "Throws an error when called, i.e., an assignment is made." - ] - readerOptionsMembers - --- | 'ReaderOptions' object type. -typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions -typeReaderOptions = deftype "ReaderOptions" - [ operation Tostring $ lambda - ### liftPure show - <#> udparam typeReaderOptions "opts" "options to print in native format" - =#> functionResult pushString "string" "Haskell representation" - ] - readerOptionsMembers - --- | Member properties of 'ReaderOptions' Lua values. -readerOptionsMembers :: LuaError e - => [Member e (DocumentedFunction e) ReaderOptions] -readerOptionsMembers = - [ property "abbreviations" "" - (pushSet pushText, readerAbbreviations) - (peekSet peekText, \opts x -> opts{ readerAbbreviations = x }) - , property "columns" "" - (pushIntegral, readerColumns) - (peekIntegral, \opts x -> opts{ readerColumns = x }) - , property "default_image_extension" "" - (pushText, readerDefaultImageExtension) - (peekText, \opts x -> opts{ readerDefaultImageExtension = x }) - , property "extensions" "" - (pushString . show, readerExtensions) - (peekRead, \opts x -> opts{ readerExtensions = x }) - , property "indented_code_classes" "" - (pushPandocList pushText, readerIndentedCodeClasses) - (peekList peekText, \opts x -> opts{ readerIndentedCodeClasses = x }) - , property "strip_comments" "" - (pushBool, readerStripComments) - (peekBool, \opts x -> opts{ readerStripComments = x }) - , property "standalone" "" - (pushBool, readerStandalone) - (peekBool, \opts x -> opts{ readerStandalone = x }) - , property "tab_stop" "" - (pushIntegral, readerTabStop) - (peekIntegral, \opts x -> opts{ readerTabStop = x }) - , property "track_changes" "" - (pushString . show, readerTrackChanges) - (peekRead, \opts x -> opts{ readerTrackChanges = x }) - ] - --- | Retrieves a 'ReaderOptions' object from a table on the stack, using --- the default values for all missing fields. --- --- Internally, this pushes the default reader options, sets each --- key/value pair of the table in the userdata value, then retrieves the --- object again. This will update all fields and complain about unknown --- keys. -peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions -peekReaderOptionsTable idx = retrieving "ReaderOptions (table)" $ do - liftLua $ do - absidx <- absindex idx - pushUD typeReaderOptions def - let setFields = do - next absidx >>= \case - False -> return () -- all fields were copied - True -> do - pushvalue (nth 2) *> insert (nth 2) - settable (nth 4) -- set in userdata object - setFields - pushnil -- first key - setFields - peekUD typeReaderOptions top - -instance Pushable ReaderOptions where - push = pushReaderOptions diff --git a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs b/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs deleted file mode 100644 index 65f5aec8b..000000000 --- a/src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{- | - Module : Text.Pandoc.Lua.Marshaling.SimpleTable - Copyright : © 2020-2021 Albert Krewinkel - License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel - -Definition and marshaling of the 'SimpleTable' data type used as a -convenience type when dealing with tables. --} -module Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..) - , peekSimpleTable - , pushSimpleTable - , mkSimpleTable - ) - where - -import HsLua as Lua -import Text.Pandoc.Definition -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.List - --- | A simple (legacy-style) table. -data SimpleTable = SimpleTable - { simpleTableCaption :: [Inline] - , simpleTableAlignments :: [Alignment] - , simpleTableColumnWidths :: [Double] - , simpleTableHeader :: [[Block]] - , simpleTableBody :: [[[Block]]] - } deriving (Eq, Show) - -typeSimpleTable :: LuaError e => DocumentedType e SimpleTable -typeSimpleTable = deftype "SimpleTable" - [ operation Eq $ lambda - ### liftPure2 (==) - <#> udparam typeSimpleTable "a" "" - <#> udparam typeSimpleTable "b" "" - =#> functionResult pushBool "boolean" "whether the two objects are equal" - , operation Tostring $ lambda - ### liftPure show - <#> udparam typeSimpleTable "self" "" - =#> functionResult pushString "string" "Haskell string representation" - ] - [ property "caption" "table caption" - (pushPandocList pushInline, simpleTableCaption) - (peekInlinesFuzzy, \t capt -> t {simpleTableCaption = capt}) - , property "aligns" "column alignments" - (pushPandocList (pushString . show), simpleTableAlignments) - (peekList peekRead, \t aligns -> t{simpleTableAlignments = aligns}) - , property "widths" "relative column widths" - (pushPandocList pushRealFloat, simpleTableColumnWidths) - (peekList peekRealFloat, \t ws -> t{simpleTableColumnWidths = ws}) - , property "headers" "table header" - (pushRow, simpleTableHeader) - (peekRow, \t h -> t{simpleTableHeader = h}) - , property "rows" "table body rows" - (pushPandocList pushRow, simpleTableBody) - (peekList peekRow, \t bs -> t{simpleTableBody = bs}) - - , readonly "t" "type tag (always 'SimpleTable')" - (pushText, const "SimpleTable") - - , alias "header" "alias for `headers`" ["headers"] - ] - where - pushRow = pushPandocList (pushPandocList pushBlock) - -peekRow :: LuaError e => Peeker e [[Block]] -peekRow = peekList peekBlocksFuzzy - --- | Push a simple table to the stack by calling the --- @pandoc.SimpleTable@ constructor. -pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e () -pushSimpleTable = pushUD typeSimpleTable - --- | Retrieve a simple table from the stack. -peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable -peekSimpleTable = retrieving "SimpleTable" . peekUD typeSimpleTable - --- | Constructor for the 'SimpleTable' type. -mkSimpleTable :: LuaError e => DocumentedFunction e -mkSimpleTable = defun "SimpleTable" - ### liftPure5 SimpleTable - <#> parameter peekInlinesFuzzy "Inlines" "caption" "table caption" - <#> parameter (peekList peekRead) "{Alignment,...}" "align" "column alignments" - <#> parameter (peekList peekRealFloat) "{number,...}" "widths" - "relative column widths" - <#> parameter peekRow "{Blocks,...}" "header" "table header row" - <#> parameter (peekList peekRow) "{{Blocks,...},...}" "body" "table body rows" - =#> functionResult pushSimpleTable "SimpleTable" "new SimpleTable object" diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index 6e595f9e4..fb055101e 100644 --- a/src/Text/Pandoc/Lua/Module/MediaBag.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -21,8 +21,8 @@ import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState, setMediaBag) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) +import Text.Pandoc.Lua.Marshal.List (pushPandocList) +import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Lua.PandocLua (unPandocLua) import Text.Pandoc.MIME (MimeType) diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index a8b111092..085d904cf 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -19,35 +19,28 @@ module Text.Pandoc.Lua.Module.Pandoc ) where import Prelude hiding (read) -import Control.Applicative ((<|>)) -import Control.Monad ((<$!>), forM_, when) +import Control.Monad (forM_, when) import Control.Monad.Catch (catch, throwM) import Control.Monad.Except (throwError) import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (Proxy)) -import Data.Text (Text) -import HsLua hiding (Div, pushModule) +import HsLua hiding (pushModule) import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (SingletonsList (..), LuaFilter, peekLuaFilter, +import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter, + peekLuaFilter, walkInlines, walkInlineLists, walkBlocks, walkBlockLists) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST -import Text.Pandoc.Lua.Marshaling.Attr (mkAttr, mkAttributeList) -import Text.Pandoc.Lua.Marshaling.List (List (..)) -import Text.Pandoc.Lua.Marshaling.ListAttributes ( mkListAttributes - , peekListAttributes) -import Text.Pandoc.Lua.Marshaling.ReaderOptions ( peekReaderOptions +import Text.Pandoc.Lua.Orphans () +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions , pushReaderOptions) -import Text.Pandoc.Lua.Marshaling.SimpleTable (mkSimpleTable) import Text.Pandoc.Lua.Module.Utils (sha1) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, - loadDefaultModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) @@ -65,21 +58,6 @@ import Text.Pandoc.Error pushModule :: PandocLua NumResults pushModule = do liftPandocLua $ Lua.pushModule documentedModule - loadDefaultModule "pandoc" - let copyNext = do - hasNext <- next (nth 2) - if not hasNext - then return () - else do - pushvalue (nth 2) - insert (nth 2) - rawset (nth 5) -- pandoc module - copyNext - liftPandocLua $ do - pushnil -- initial key - copyNext - pop 1 - return 1 documentedModule :: Module PandocError @@ -97,6 +75,7 @@ documentedModule = Module , otherConstructors , blockConstructors , inlineConstructors + , metaValueConstructors ] } @@ -132,229 +111,13 @@ pushWithConstructorsSubtable constructors = do rawset (nth 3) pop 1 -- pop constructor table -inlineConstructors :: LuaError e => [DocumentedFunction e] -inlineConstructors = - [ defun "Cite" - ### liftPure2 (flip Cite) - <#> parameter peekInlinesFuzzy "content" "Inline" "placeholder content" - <#> parameter (peekList peekCitation) "citations" "list of Citations" "" - =#> functionResult pushInline "Inline" "cite element" - , defun "Code" - ### liftPure2 (\text mattr -> Code (fromMaybe nullAttr mattr) text) - <#> parameter peekText "code" "string" "code string" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "code element" - , mkInlinesConstr "Emph" Emph - , defun "Image" - ### liftPure4 (\caption src mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Image attr caption (src, title)) - <#> parameter peekInlinesFuzzy "Inlines" "caption" "image caption / alt" - <#> parameter peekText "string" "src" "path/URL of the image file" - <#> optionalParameter peekText "string" "title" "brief image description" - <#> optionalParameter peekAttr "Attr" "attr" "image attributes" - =#> functionResult pushInline "Inline" "image element" - , defun "LineBreak" - ### return LineBreak - =#> functionResult pushInline "Inline" "line break" - , defun "Link" - ### liftPure4 (\content target mtitle mattr -> - let attr = fromMaybe nullAttr mattr - title = fromMaybe mempty mtitle - in Link attr content (target, title)) - <#> parameter peekInlinesFuzzy "Inlines" "content" "text for this link" - <#> parameter peekText "string" "target" "the link target" - <#> optionalParameter peekText "string" "title" "brief link description" - <#> optionalParameter peekAttr "Attr" "attr" "link attributes" - =#> functionResult pushInline "Inline" "link element" - , defun "Math" - ### liftPure2 Math - <#> parameter peekMathType "quotetype" "Math" "rendering method" - <#> parameter peekText "text" "string" "math content" - =#> functionResult pushInline "Inline" "math element" - , defun "Note" - ### liftPure Note - <#> parameter peekBlocksFuzzy "content" "Blocks" "note content" - =#> functionResult pushInline "Inline" "note" - , defun "Quoted" - ### liftPure2 Quoted - <#> parameter peekQuoteType "quotetype" "QuoteType" "type of quotes" - <#> parameter peekInlinesFuzzy "content" "Inlines" "inlines in quotes" - =#> functionResult pushInline "Inline" "quoted element" - , defun "RawInline" - ### liftPure2 RawInline - <#> parameter peekFormat "format" "Format" "format of content" - <#> parameter peekText "text" "string" "string content" - =#> functionResult pushInline "Inline" "raw inline element" - , mkInlinesConstr "SmallCaps" SmallCaps - , defun "SoftBreak" - ### return SoftBreak - =#> functionResult pushInline "Inline" "soft break" - , defun "Space" - ### return Space - =#> functionResult pushInline "Inline" "new space" - , defun "Span" - ### liftPure2 (\inlns mattr -> Span (fromMaybe nullAttr mattr) inlns) - <#> parameter peekInlinesFuzzy "content" "Inlines" "inline content" - <#> optionalParameter peekAttr "attr" "Attr" "additional attributes" - =#> functionResult pushInline "Inline" "span element" - , defun "Str" - ### liftPure Str - <#> parameter peekText "text" "string" "" - =#> functionResult pushInline "Inline" "new Str object" - , mkInlinesConstr "Strong" Strong - , mkInlinesConstr "Strikeout" Strikeout - , mkInlinesConstr "Subscript" Subscript - , mkInlinesConstr "Superscript" Superscript - , mkInlinesConstr "Underline" Underline - ] - -blockConstructors :: LuaError e => [DocumentedFunction e] -blockConstructors = - [ defun "BlockQuote" - ### liftPure BlockQuote - <#> blocksParam - =#> blockResult "BlockQuote element" - - , defun "BulletList" - ### liftPure BulletList - <#> blockItemsParam "list items" - =#> blockResult "BulletList element" - - , defun "CodeBlock" - ### liftPure2 (\code mattr -> CodeBlock (fromMaybe nullAttr mattr) code) - <#> textParam "text" "code block content" - <#> optAttrParam - =#> blockResult "CodeBlock element" - - , defun "DefinitionList" - ### liftPure DefinitionList - <#> parameter (choice - [ peekList peekDefinitionItem - , \idx -> (:[]) <$!> peekDefinitionItem idx - ]) - "{{Inlines, {Blocks,...}},...}" - "content" "definition items" - =#> blockResult "DefinitionList element" - - , defun "Div" - ### liftPure2 (\content mattr -> Div (fromMaybe nullAttr mattr) content) - <#> blocksParam - <#> optAttrParam - =#> blockResult "Div element" - - , defun "Header" - ### liftPure3 (\lvl content mattr -> - Header lvl (fromMaybe nullAttr mattr) content) - <#> parameter peekIntegral "integer" "level" "heading level" - <#> parameter peekInlinesFuzzy "Inlines" "content" "inline content" - <#> optAttrParam - =#> blockResult "Header element" - - , defun "HorizontalRule" - ### return HorizontalRule - =#> blockResult "HorizontalRule element" - - , defun "LineBlock" - ### liftPure LineBlock - <#> parameter (peekList peekInlinesFuzzy) "{Inlines,...}" "content" "lines" - =#> blockResult "LineBlock element" - - , defun "Null" - ### return Null - =#> blockResult "Null element" - - , defun "OrderedList" - ### liftPure2 (\items mListAttrib -> - let defListAttrib = (1, DefaultStyle, DefaultDelim) - in OrderedList (fromMaybe defListAttrib mListAttrib) items) - <#> blockItemsParam "ordered list items" - <#> optionalParameter peekListAttributes "ListAttributes" "listAttributes" - "specifier for the list's numbering" - =#> blockResult "OrderedList element" - - , defun "Para" - ### liftPure Para - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Para element" - - , defun "Plain" - ### liftPure Plain - <#> parameter peekInlinesFuzzy "Inlines" "content" "paragraph content" - =#> blockResult "Plain element" - - , defun "RawBlock" - ### liftPure2 RawBlock - <#> parameter peekFormat "Format" "format" "format of content" - <#> parameter peekText "string" "text" "raw content" - =#> blockResult "RawBlock element" - - , defun "Table" - ### (\capt colspecs thead tbodies tfoot mattr -> - let attr = fromMaybe nullAttr mattr - in return $! attr `seq` capt `seq` colspecs `seq` thead `seq` tbodies - `seq` tfoot `seq` Table attr capt colspecs thead tbodies tfoot) - <#> parameter peekCaption "Caption" "caption" "table caption" - <#> parameter (peekList peekColSpec) "{ColSpec,...}" "colspecs" - "column alignments and widths" - <#> parameter peekTableHead "TableHead" "head" "table head" - <#> parameter (peekList peekTableBody) "{TableBody,...}" "bodies" - "table bodies" - <#> parameter peekTableFoot "TableFoot" "foot" "table foot" - <#> optAttrParam - =#> blockResult "Table element" - ] - where - blockResult = functionResult pushBlock "Block" - blocksParam = parameter peekBlocksFuzzy "Blocks" "content" "block content" - blockItemsParam = parameter peekItemsFuzzy "List of Blocks" "content" - peekItemsFuzzy idx = peekList peekBlocksFuzzy idx - <|> ((:[]) <$!> peekBlocksFuzzy idx) - -textParam :: LuaError e => Text -> Text -> Parameter e Text -textParam = parameter peekText "string" - -optAttrParam :: LuaError e => Parameter e (Maybe Attr) -optAttrParam = optionalParameter peekAttr "attr" "Attr" "additional attributes" - -mkInlinesConstr :: LuaError e - => Name -> ([Inline] -> Inline) -> DocumentedFunction e -mkInlinesConstr name constr = defun name - ### liftPure (\x -> x `seq` constr x) - <#> parameter peekInlinesFuzzy "content" "Inlines" "" - =#> functionResult pushInline "Inline" "new object" - otherConstructors :: LuaError e => [DocumentedFunction e] otherConstructors = - [ defun "Pandoc" - ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks) - <#> parameter peekBlocksFuzzy "Blocks" "blocks" "document contents" - <#> optionalParameter peekMeta "Meta" "meta" "document metadata" - =#> functionResult pushPandoc "Pandoc" "new Pandoc document" - - , defun "Citation" - ### (\cid mode mprefix msuffix mnote_num mhash -> - cid `seq` mode `seq` mprefix `seq` msuffix `seq` - mnote_num `seq` mhash `seq` return $! Citation - { citationId = cid - , citationMode = mode - , citationPrefix = fromMaybe mempty mprefix - , citationSuffix = fromMaybe mempty msuffix - , citationNoteNum = fromMaybe 0 mnote_num - , citationHash = fromMaybe 0 mhash - }) - <#> parameter peekText "string" "cid" "citation ID (e.g. bibtex key)" - <#> parameter peekRead "citation mode" "mode" "citation rendering mode" - <#> optionalParameter peekInlinesFuzzy "prefix" "Inlines" "" - <#> optionalParameter peekInlinesFuzzy "suffix" "Inlines" "" - <#> optionalParameter peekIntegral "note_num" "integer" "note number" - <#> optionalParameter peekIntegral "hash" "integer" "hash number" - =#> functionResult pushCitation "Citation" "new citation object" - #? "Creates a single citation." - + [ mkPandoc + , mkMeta , mkAttr , mkAttributeList + , mkCitation , mkListAttributes , mkSimpleTable diff --git a/src/Text/Pandoc/Lua/Module/Types.hs b/src/Text/Pandoc/Lua/Module/Types.hs index 4b37dafd9..f16737f63 100644 --- a/src/Text/Pandoc/Lua/Module/Types.hs +++ b/src/Text/Pandoc/Lua/Module/Types.hs @@ -13,14 +13,11 @@ module Text.Pandoc.Lua.Module.Types ( documentedModule ) where -import HsLua ( LuaE, NumResults, Peeker, Pusher, Module (..), Field (..) - , defun, functionResult, parameter, (###), (<#>), (=#>)) +import HsLua ( Module (..), (###), (<#>), (=#>) + , defun, functionResult, parameter) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.ErrorConversion () -import Text.Pandoc.Lua.Marshaling.AST - -import qualified HsLua as Lua -- | Push the pandoc.types module on the Lua stack. documentedModule :: Module PandocError @@ -28,16 +25,7 @@ documentedModule = Module { moduleName = "pandoc.types" , moduleDescription = "Constructors for types that are not part of the pandoc AST." - , moduleFields = - [ Field - { fieldName = "clone" - , fieldDescription = "DEPRECATED! Helper functions for element cloning." - , fieldPushValue = do - Lua.newtable - addFunction "Meta" $ cloneWith peekMeta pushMeta - addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue - } - ] + , moduleFields = [] , moduleFunctions = [ defun "Version" ### return @@ -52,15 +40,3 @@ documentedModule = Module ] , moduleOperations = [] } - where addFunction name fn = do - Lua.pushName name - Lua.pushHaskellFunction fn - Lua.rawset (Lua.nth 3) - -cloneWith :: Peeker PandocError a - -> Pusher PandocError a - -> LuaE PandocError NumResults -cloneWith peeker pusher = do - x <- Lua.forcePeek $ peeker (Lua.nthBottom 1) - pusher x - return (Lua.NumResults 1) diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 6fd707bf8..917f2e627 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -27,14 +27,7 @@ import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.Marshaling () -import Text.Pandoc.Lua.Marshaling.AST - ( peekBlock, peekInline, peekPandoc, pushBlock, pushInline, pushInlines - , pushPandoc, peekAttr, peekMeta, peekMetaValue) -import Text.Pandoc.Lua.Marshaling.ListAttributes (peekListAttributes) -import Text.Pandoc.Lua.Marshaling.List (pushPandocList) -import Text.Pandoc.Lua.Marshaling.SimpleTable - ( SimpleTable (..), peekSimpleTable, pushSimpleTable ) +import Text.Pandoc.Lua.Marshal.AST import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA diff --git a/src/Text/Pandoc/Lua/Orphans.hs b/src/Text/Pandoc/Lua/Orphans.hs new file mode 100644 index 000000000..eef05bd27 --- /dev/null +++ b/src/Text/Pandoc/Lua/Orphans.hs @@ -0,0 +1,111 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} +{- | + Module : Text.Pandoc.Lua.Orphans + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Orphan instances for Lua's Pushable and Peekable type classes. +-} +module Text.Pandoc.Lua.Orphans () where + +import Data.Version (Version) +import HsLua +import HsLua.Module.Version (peekVersionFuzzy) +import Text.Pandoc.Definition +import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.CommonState () +import Text.Pandoc.Lua.Marshal.Context () +import Text.Pandoc.Lua.Marshal.PandocError() +import Text.Pandoc.Lua.Marshal.ReaderOptions () +import Text.Pandoc.Lua.ErrorConversion () + +instance Pushable Pandoc where + push = pushPandoc + +instance Pushable Meta where + push = pushMeta + +instance Pushable MetaValue where + push = pushMetaValue + +instance Pushable Block where + push = pushBlock + +instance {-# OVERLAPPING #-} Pushable [Block] where + push = pushBlocks + +instance Pushable Alignment where + push = pushString . show + +instance Pushable CitationMode where + push = pushCitationMode + +instance Pushable Format where + push = pushFormat + +instance Pushable ListNumberDelim where + push = pushString . show + +instance Pushable ListNumberStyle where + push = pushString . show + +instance Pushable MathType where + push = pushMathType + +instance Pushable QuoteType where + push = pushQuoteType + +instance Pushable Cell where + push = pushCell + +instance Peekable Cell where + peek = forcePeek . peekCell + +instance Pushable Inline where + push = pushInline + +instance {-# OVERLAPPING #-} Pushable [Inline] where + push = pushInlines + +instance Pushable Citation where + push = pushCitation + +instance Pushable Row where + push = pushRow + +instance Pushable TableBody where + push = pushTableBody + +instance Pushable TableFoot where + push = pushTableFoot + +instance Pushable TableHead where + push = pushTableHead + +-- These instances exist only for testing. It's a hack to avoid making +-- the marshalling modules public. +instance Peekable Inline where + peek = forcePeek . peekInline + +instance Peekable Block where + peek = forcePeek . peekBlock + +instance Peekable Meta where + peek = forcePeek . peekMeta + +instance Peekable Pandoc where + peek = forcePeek . peekPandoc + +instance Peekable Row where + peek = forcePeek . peekRow + +instance Peekable Version where + peek = forcePeek . peekVersionFuzzy + +instance {-# OVERLAPPING #-} Peekable Attr where + peek = forcePeek . peekAttr diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index 3a481886a..c36c3c670 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -17,7 +17,8 @@ module Text.Pandoc.Lua.Packages import Control.Monad (forM_) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule) +import Text.Pandoc.Lua.Marshal.List (pushListModule) +import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import qualified HsLua as Lua import qualified HsLua.Module.Path as Path @@ -45,7 +46,7 @@ installPandocPackageSearcher = liftPandocLua $ do pandocPackageSearcher :: String -> PandocLua Lua.NumResults pandocPackageSearcher pkgName = case pkgName of - "pandoc" -> pushWrappedHsFun $ Lua.toHaskellFunction @PandocError Pandoc.pushModule + "pandoc" -> pushModuleLoader Pandoc.documentedModule "pandoc.mediabag" -> pushModuleLoader MediaBag.documentedModule "pandoc.path" -> pushModuleLoader Path.documentedModule "pandoc.system" -> pushModuleLoader System.documentedModule @@ -53,7 +54,7 @@ pandocPackageSearcher pkgName = "pandoc.utils" -> pushModuleLoader Utils.documentedModule "text" -> pushModuleLoader Text.documentedModule "pandoc.List" -> pushWrappedHsFun . Lua.toHaskellFunction @PandocError $ - loadDefaultModule pkgName + (Lua.NumResults 1 <$ pushListModule @PandocError) _ -> reportPandocSearcherFailure where pushModuleLoader mdl = liftPandocLua $ do diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs index 6c2ebc622..71fdf8d5c 100644 --- a/src/Text/Pandoc/Lua/PandocLua.hs +++ b/src/Text/Pandoc/Lua/PandocLua.hs @@ -22,20 +22,18 @@ module Text.Pandoc.Lua.PandocLua ( PandocLua (..) , runPandocLua , liftPandocLua - , loadDefaultModule ) where import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Except (MonadError (catchError, throwError)) import Control.Monad.IO.Class (MonadIO) import HsLua as Lua -import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDefaultDataFile) -import Text.Pandoc.Error (PandocError (PandocLuaError)) +import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Global (Global (..), setGlobals) -import Text.Pandoc.Lua.Marshaling.CommonState (peekCommonState) +import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState) import qualified Control.Monad.Catch as Catch -import qualified Data.Text as T import qualified Text.Pandoc.Class.IO as IO -- | Type providing access to both, pandoc and Lua operations. @@ -75,23 +73,6 @@ instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where instance Pushable a => Exposable PandocError (PandocLua a) where partialApply _narg x = 1 <$ (unPandocLua x >>= Lua.push) --- | Load a pure Lua module included with pandoc. Leaves the result on --- the stack and returns @NumResults 1@. --- --- The script is loaded from the default data directory. We do not load --- from data directories supplied via command line, as this could cause --- scripts to be executed even though they had not been passed explicitly. -loadDefaultModule :: String -> PandocLua NumResults -loadDefaultModule name = do - script <- readDefaultDataFile (name <> ".lua") - result <- liftPandocLua $ Lua.dostring script - if result == Lua.OK - then return (1 :: NumResults) - else do - msg <- liftPandocLua Lua.popValue - let err = "Error while loading `" <> name <> "`.\n" <> msg - throwError $ PandocLuaError (T.pack err) - -- | Global variables which should always be set. defaultGlobals :: PandocMonad m => m [Global] defaultGlobals = do diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index f35201db0..6d67d340d 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Util Copyright : © 2012-2021 John MacFarlane, @@ -16,14 +11,12 @@ Lua utility functions. -} module Text.Pandoc.Lua.Util - ( getTag - , addField + ( addField , callWithTraceback , dofileWithTraceback - , pushViaConstr' ) where -import Control.Monad (unless, when) +import Control.Monad (when) import HsLua import qualified HsLua as Lua @@ -34,26 +27,6 @@ addField key value = do Lua.push value Lua.rawset (Lua.nth 3) --- | Get the tag of a value. This is an optimized and specialized version of --- @Lua.getfield idx "tag"@. It only checks for the field on the table at index --- @idx@ and on its metatable, also ignoring any @__index@ value on the --- metatable. -getTag :: LuaError e => Peeker e Name -getTag idx = do - -- push metatable or just the table - liftLua $ do - Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx) - Lua.pushName "tag" - Lua.rawget (Lua.nth 2) - Lua.peekName Lua.top `lastly` Lua.pop 2 -- table/metatable and `tag` field - -pushViaConstr' :: forall e. LuaError e => Name -> [LuaE e ()] -> LuaE e () -pushViaConstr' fnname pushArgs = do - pushName @e ("pandoc." <> fnname) - rawget @e registryindex - sequence_ pushArgs - call @e (fromIntegral (length pushArgs)) 1 - -- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a -- traceback on error. pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs index d6d973496..75ed1f471 100644 --- a/src/Text/Pandoc/Lua/Walk.hs +++ b/src/Text/Pandoc/Lua/Walk.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} {- | Module : Text.Pandoc.Lua.Walk Copyright : © 2012-2021 John MacFarlane, @@ -14,13 +16,18 @@ Walking documents in a filter-suitable way. -} module Text.Pandoc.Lua.Walk ( SingletonsList (..) + , List (..) ) where import Control.Monad ((<=<)) +import Data.Data (Data) +import HsLua (Pushable (push)) +import Text.Pandoc.Lua.Marshal.AST (pushBlocks, pushInlines) import Text.Pandoc.Definition import Text.Pandoc.Walk + -- | Helper type which allows to traverse trees in order, while splicing in -- trees. -- @@ -156,3 +163,21 @@ querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) querySingletonsList f = let f' x = f (SingletonsList [x]) `mappend` query f x in mconcat . map f' + + +-- | List wrapper where each list is processed as a whole, but special +-- pushed to Lua in type-dependent ways. +-- +-- The walk instance is basically that of unwrapped Haskell lists. +newtype List a = List { fromList :: [a] } + deriving (Data, Eq, Show) + +instance Pushable (List Block) where + push (List xs) = pushBlocks xs + +instance Pushable (List Inline) where + push (List xs) = pushInlines xs + +instance Walkable [a] b => Walkable (List a) b where + walkM f = walkM (fmap fromList . f . List) + query f = query (f . List) diff --git a/stack.yaml b/stack.yaml index c77ee622f..71c25c0be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -23,7 +23,7 @@ extra-deps: - hslua-module-version-1.0.0 - hslua-objectorientation-2.0.1 - hslua-packaging-2.0.0 -- lua-2.0.1 +- lua-2.0.2 - tasty-hslua-1.0.0 - tasty-lua-1.0.0 - pandoc-types-1.22.1 @@ -33,6 +33,8 @@ extra-deps: - aeson-pretty-0.8.9 - ipynb-0.1.0.2 - texmath-0.12.3.3 +- git: https://github.com/tarleb/hslua-pandoc-types.git + commit: 56387e543c48cc5518a77c2a271ff211653f2a36 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-18.10 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 2070695e3..7ef21f933 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -238,7 +238,7 @@ tests = map (localOption (QuickCheckTests 20)) case eitherPandoc of Left (PandocLuaError msg) -> do let expectedMsg = "Pandoc expected, got boolean\n" - <> "\twhile retrieving Pandoc value" + <> "\twhile retrieving Pandoc" Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg Left e -> error ("Expected a Lua error, but got " <> show e) Right _ -> error "Getting a Pandoc element from a bool should fail." @@ -266,7 +266,6 @@ roundtripEqual x = (x ==) <$> roundtripped runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a runLuaTest op = runIOorExplode $ do - setUserDataDir (Just "../data") res <- runLua op case res of Left e -> error (show e) diff --git a/test/lua/module/pandoc.lua b/test/lua/module/pandoc.lua index 2849eedbf..1cf777675 100644 --- a/test/lua/module/pandoc.lua +++ b/test/lua/module/pandoc.lua @@ -8,715 +8,124 @@ function os_is_windows () return package.config:sub(1,1) == '\\' end +-- Constructor behavior is tested in the hslua-pandoc-types module, so +-- we just make sure the functions are present. return { - group 'Attr' { - group 'Constructor' { + group 'Constructors' { + group 'Misc' { test('pandoc.Attr is a function', function () assert.are_equal(type(pandoc.Attr), 'function') end), - test('returns null-Attr if no arguments are given', function () - local attr = pandoc.Attr() - assert.are_equal(attr.identifier, '') - assert.are_same(attr.classes, {}) - assert.are_same(#attr.attributes, 0) - end), - test( - 'accepts string-indexed table or list of pairs as attributes', - function () - local attributes_list = {{'one', '1'}, {'two', '2'}} - local attr_from_list = pandoc.Attr('', {}, attributes_list) - - assert.are_equal(attr_from_list.attributes.one, '1') - assert.are_equal(attr_from_list.attributes.two, '2') - - local attributes_table = {one = '1', two = '2'} - local attr_from_table = pandoc.Attr('', {}, attributes_table) - assert.are_equal( - attr_from_table.attributes, - pandoc.AttributeList(attributes_table) - ) - assert.are_equal(attr_from_table.attributes.one, '1') - assert.are_equal(attr_from_table.attributes.two, '2') - end - ) - }, - group 'Properties' { - test('has t and tag property', function () - local attr = pandoc.Attr('') - assert.are_equal(attr.t, 'Attr') - assert.are_equal(attr.tag, 'Attr') - end) - }, - group 'AttributeList' { - test('allows access via fields', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_equal(attributes.a, '1') - assert.are_equal(attributes.b, '2') - end), - test('allows access to pairs via numerical indexing', function () - local attributes = pandoc.Attr('', {}, {{'a', '1'}, {'b', '2'}}).attributes - assert.are_same(attributes[1], {'a', '1'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows replacing a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = {'t','five'} - assert.are_same(attributes[1], {'t', 'five'}) - assert.are_same(attributes[2], {'b', '2'}) - end), - test('allows to remove a pair', function () - local attributes = pandoc.AttributeList{{'a', '1'}, {'b', '2'}} - attributes[1] = nil - assert.are_equal(#attributes, 1) - end), - test('adds entries by field name', function () - local attributes = pandoc.Attr('',{}, {{'c', '1'}, {'d', '2'}}).attributes - attributes.e = '3' - assert.are_same( - attributes, - -- checking the full AttributeList would "duplicate" entries - pandoc.AttributeList{{'c', '1'}, {'d', '2'}, {'e', '3'}} - ) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.AttributeList), 'function') end), - test('deletes entries by field name', function () - local attributes = pandoc.Attr('',{}, {a = '1', b = '2'}).attributes - attributes.a = nil - assert.is_nil(attributes.a) - assert.are_same(attributes, pandoc.AttributeList{{'b', '2'}}) - end), - test('remains unchanged if deleted key did not exist', function () - local assoc_list = pandoc.List:new {{'alpha', 'x'}, {'beta', 'y'}} - local attributes = pandoc.Attr('', {}, assoc_list).attributes - attributes.a = nil - local new_assoc_list = pandoc.List() - for k, v in pairs(attributes) do - new_assoc_list:insert({k, v}) - end - assert.are_same(new_assoc_list, assoc_list) - end), - test('gives key-value pairs when iterated-over', function () - local attributes = {width = '11', height = '22', name = 'test'} - local attr = pandoc.Attr('', {}, attributes) - local count = 0 - for k, v in pairs(attr.attributes) do - assert.are_equal(attributes[k], v) - count = count + 1 - end - assert.are_equal(count, 3) - end) - }, - group 'HTML-like attribute tables' { - test('in element constructor', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = '11', - height = '12' - } - local attr = pandoc.Span('test', html_attributes).attr - assert.are_equal(attr.identifier, 'the-id') - assert.are_equal(attr.classes[1], 'class1') - assert.are_equal(attr.classes[2], 'class2') - assert.are_equal(attr.attributes.width, '11') - assert.are_equal(attr.attributes.height, '12') - end), - test('element attr setter', function () - local html_attributes = { - id = 'the-id', - class = 'class1 class2', - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attr = html_attributes - span = span:clone() -- normalize - assert.are_equal(span.attr.identifier, 'the-id') - assert.are_equal(span.attr.classes[1], 'class1') - assert.are_equal(span.attr.classes[2], 'class2') - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end), - test('element attrbutes setter', function () - local attributes = { - width = "11", - height = "12" - } - local span = pandoc.Span 'test' - span.attributes = attributes - assert.are_equal(span.attr.attributes.width, '11') - assert.are_equal(span.attr.attributes.height, '12') - end) - } - }, - group "Inline elements" { - group 'Cite' { - test('has property `content`', function () - local cite = pandoc.Cite({pandoc.Emph 'important'}, {}) - assert.are_same(cite.content, {pandoc.Emph {pandoc.Str 'important'}}) - - cite.content = 'boring' - assert.are_equal(cite, pandoc.Cite({pandoc.Str 'boring'}, {})) - end), - test('has list of citations in property `cite`', function () - local citations = { - pandoc.Citation('einstein1905', 'NormalCitation') - } - local cite = pandoc.Cite('relativity', citations) - assert.are_same(cite.citations, citations) - - local new_citations = { - citations[1], - pandoc.Citation('Poincaré1905', 'NormalCitation') - } - cite.citations = new_citations - assert.are_equal(cite, pandoc.Cite({'relativity'}, new_citations)) + test('pandoc.Citation is a function', function () + assert.are_equal(type(pandoc.Citation), 'function') end), - }, - group 'Code' { - test('has property `attr`', function () - local code = pandoc.Code('true', {id='true', foo='bar'}) - assert.are_equal(code.attr, pandoc.Attr('true', {}, {{'foo', 'bar'}})) - - code.attr = {id='t', fubar='quux'} - assert.are_equal( - pandoc.Code('true', pandoc.Attr('t', {}, {{'fubar', 'quux'}})), - code - ) + test('pandoc.SimpleTable is a function', function () + assert.are_equal(type(pandoc.SimpleTable), 'function') end), - test('has property `text`', function () - local code = pandoc.Code('true') - assert.are_equal(code.text, 'true') - - code.text = '1 + 1' - assert.are_equal(pandoc.Code('1 + 1'), code) + test('pandoc.Meta is a function', function () + assert.are_equal(type(pandoc.Meta), 'function') + end), + test('pandoc.Pandoc is a function', function () + assert.are_equal(type(pandoc.Pandoc), 'function') end), }, - group 'Emph' { - test('has property `content`', function () - local elem = pandoc.Emph{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Emph{'word'}) - end) - }, - group 'Image' { - test('has property `caption`', function () - local img = pandoc.Image('example', 'a.png') - assert.are_same(img.caption, {pandoc.Str 'example'}) - - img.caption = 'A' - assert.are_equal(img, pandoc.Image({'A'}, 'a.png')) + group "Inline elements" { + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Cite), 'function') end), - test('has property `src`', function () - local img = pandoc.Image('example', 'sample.png') - assert.are_same(img.src, 'sample.png') - - img.src = 'example.svg' - assert.are_equal(img, pandoc.Image('example', 'example.svg')) + test('pandoc.AttributeList is a function', function () + assert.are_equal(type(pandoc.Code), 'function') end), - test('has property `title`', function () - local img = pandoc.Image('here', 'img.gif', 'example') - assert.are_same(img.title, 'example') - - img.title = 'a' - assert.are_equal(img, pandoc.Image('here', 'img.gif', 'a')) + test('pandoc.Emph is a function', function () + assert.are_equal(type(pandoc.Emph), 'function') end), - test('has property `attr`', function () - local img = pandoc.Image('up', 'upwards.png', '', {'up', {'point'}}) - assert.are_same(img.attr, pandoc.Attr {'up', {'point'}}) - - img.attr = pandoc.Attr {'up', {'point', 'button'}} - assert.are_equal( - pandoc.Image('up', 'upwards.png', nil, {'up', {'point', 'button'}}), - img - ) - end) - }, - group 'Link' { - test('has property `content`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.content = 'commercial' - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('commercial', 'https://example.com')) + test('pandoc.Image is a function', function () + assert.are_equal(type(pandoc.Image), 'function') end), - test('has property `target`', function () - local link = pandoc.Link('example', 'https://example.org') - assert.are_same(link.content, {pandoc.Str 'example'}) - - link.target = 'https://example.com' - assert.are_equal(link, pandoc.Link('example', 'https://example.com')) + test('pandoc.Link is a function', function () + assert.are_equal(type(pandoc.Link), 'function') end), - test('has property `title`', function () - local link = pandoc.Link('here', 'https://example.org', 'example') - assert.are_same(link.title, 'example') - - link.title = 'a' - assert.are_equal(link, pandoc.Link('here', 'https://example.org', 'a')) + test('pandoc.Math is a function', function () + assert.are_equal(type(pandoc.Math), 'function') end), - test('has property `attr`', function () - local link = pandoc.Link('up', '../index.html', '', {'up', {'nav'}}) - assert.are_same(link.attr, pandoc.Attr {'up', {'nav'}}) - - link.attr = pandoc.Attr {'up', {'nav', 'button'}} - assert.are_equal( - pandoc.Link('up', '../index.html', nil, {'up', {'nav', 'button'}}), - link - ) - end) - }, - group 'Math' { - test('has property `text`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.text, 'x^2') - elem.text = 'a + b' - assert.are_equal(elem, pandoc.Math(pandoc.InlineMath, 'a + b')) - end), - test('has property `mathtype`', function () - local elem = pandoc.Math(pandoc.InlineMath, 'x^2') - assert.are_same(elem.mathtype, 'InlineMath') - elem.mathtype = pandoc.DisplayMath - assert.are_equal(elem, pandoc.Math(pandoc.DisplayMath, 'x^2')) + test('pandoc.Note is a function', function () + assert.are_equal(type(pandoc.Note), 'function') end), - }, - group 'Note' { - test('has property `content`', function () - local elem = pandoc.Note{pandoc.Para {'two', pandoc.Space(), 'words'}} - assert.are_same( - elem.content, - {pandoc.Para {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'}} - ) - elem.content = pandoc.Plain 'word' - assert.are_equal(elem, pandoc.Note{'word'}) - end) - }, - group 'Quoted' { - test('has property `content`', function () - local elem = pandoc.Quoted('SingleQuote', pandoc.Emph{'emph'}) - assert.are_same( - elem.content, - {pandoc.Emph{pandoc.Str 'emph'}} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Quoted(pandoc.SingleQuote, {'word'})) - end), - test('has property `quotetype`', function () - local elem = pandoc.Quoted('SingleQuote', 'a') - assert.are_same(elem.quotetype, pandoc.SingleQuote) - elem.quotetype = 'DoubleQuote' - assert.are_equal(elem, pandoc.Quoted(pandoc.DoubleQuote, {'a'})) - end) - }, - group 'SmallCaps' { - test('has property `content`', function () - local elem = pandoc.SmallCaps{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.SmallCaps{'word'}) - end) - }, - group 'SoftBreak' { - test('can be constructed', function () - local sb = pandoc.SoftBreak() - assert.are_equal(sb.t, 'SoftBreak') - end) - }, - group 'Span' { - test('has property `attr`', function () - local elem = pandoc.Span('one', {'', {'number'}}) - assert.are_same( - elem.attr, - pandoc.Attr('', {'number'}) - ) - elem.attr = {'', {}, {{'a', 'b'}}} - assert.are_equal(elem, pandoc.Span({'one'}, {a='b'})) - end), - test('has property `content`', function () - local elem = pandoc.Span{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Span{'word'}) - end) - }, - group 'Str' { - test('has property `text`', function () - local elem = pandoc.Str 'nein' - assert.are_same(elem.text, 'nein') - elem.text = 'doch' - assert.are_equal(elem, pandoc.Str 'doch') - end) - }, - group 'Strikeout' { - test('has property `content`', function () - local elem = pandoc.Strikeout{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strikeout{'word'}) - end) - }, - group 'Strong' { - test('has property `content`', function () - local elem = pandoc.Strong{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Strong{'word'}) - end) - }, - group 'Subscript' { - test('has property `content`', function () - local elem = pandoc.Subscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Subscript{'word'}) - end) - }, - group 'Superscript' { - test('has property `content`', function () - local elem = pandoc.Superscript{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Superscript{'word'}) - end) - }, - group 'Underline' { - test('has property `content`', function () - local elem = pandoc.Underline{'two', pandoc.Space(), 'words'} - assert.are_same( - elem.content, - {pandoc.Str 'two', pandoc.Space(), pandoc.Str 'words'} - ) - elem.content = {'word'} - assert.are_equal(elem, pandoc.Underline{'word'}) - end) - }, - }, - group "Block elements" { - group 'BlockQuote' { - test('access content via property `content`', function () - local elem = pandoc.BlockQuote{'word'} - assert.are_same(elem.content, {pandoc.Plain 'word'}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.BlockQuote{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Quoted is a function', function () + assert.are_equal(type(pandoc.Quoted), 'function') end), - }, - group 'BulletList' { - test('access items via property `content`', function () - local para = pandoc.Para 'one' - local blist = pandoc.BulletList{{para}} - assert.are_same({{para}}, blist.content) - end), - test('property `content` uses fuzzy marshalling', function () - local old = pandoc.Plain 'old' - local new = pandoc.Plain 'new' - local blist = pandoc.BulletList{{old}} - blist.content = {{new}} - assert.are_same({{new}}, blist:clone().content) - blist.content = new - assert.are_same({{new}}, blist:clone().content) + test('pandoc.SmallCaps is a function', function () + assert.are_equal(type(pandoc.SmallCaps), 'function') end), - }, - group 'CodeBlock' { - test('access code via property `text`', function () - local cb = pandoc.CodeBlock('return true') - assert.are_equal(cb.text, 'return true') - assert.are_equal(type(cb.text), 'string') - - cb.text = 'return nil' - assert.are_equal(cb, pandoc.CodeBlock('return nil')) + test('pandoc.SoftBreak is a function', function () + assert.are_equal(type(pandoc.SoftBreak), 'function') end), - test('access Attr via property `attr`', function () - local cb = pandoc.CodeBlock('true', {'my-code', {'lua'}}) - assert.are_equal(cb.attr, pandoc.Attr{'my-code', {'lua'}}) - assert.are_equal(type(cb.attr), 'userdata') - - cb.attr = pandoc.Attr{'my-other-code', {'java'}} - assert.are_equal( - pandoc.CodeBlock('true', {'my-other-code', {'java'}}), - cb - ) - end) - }, - group 'DefinitionList' { - test('access items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{pandoc.Plain 'fruit'}, {pandoc.Plain 'company'}}}, - {pandoc.Str 'coffee', 'Best when hot.'} - } - assert.are_equal(#deflist.content, 2) - assert.are_same(deflist.content[1][1], {pandoc.Str 'apple'}) - assert.are_same(deflist.content[1][2][2], - {pandoc.Plain{pandoc.Str 'company'}}) - assert.are_same(deflist.content[2][2], - {{pandoc.Plain{ - pandoc.Str 'Best', pandoc.Space(), - pandoc.Str 'when', pandoc.Space(), - pandoc.Str 'hot.'}}}) - end), - test('modify items via property `content`', function () - local deflist = pandoc.DefinitionList{ - {'apple', {{{'fruit'}}, {{'company'}}}} - } - deflist.content[1][1] = pandoc.Str 'orange' - deflist.content[1][2][1] = {pandoc.Plain 'tasty fruit'} - local newlist = pandoc.DefinitionList{ - { {pandoc.Str 'orange'}, - {{pandoc.Plain 'tasty fruit'}, {pandoc.Plain 'company'}} - } - } - assert.are_equal(deflist, newlist) + test('pandoc.Span is a function', function () + assert.are_equal(type(pandoc.Span), 'function') end), - }, - group 'Div' { - test('access content via property `content`', function () - local elem = pandoc.Div{pandoc.BlockQuote{pandoc.Plain 'word'}} - assert.are_same(elem.content, {pandoc.BlockQuote{'word'}}) - assert.are_equal(type(elem.content), 'table') - - elem.content = { - pandoc.Para{pandoc.Str 'one'}, - pandoc.Para{pandoc.Str 'two'} - } - assert.are_equal( - pandoc.Div{ - pandoc.Para 'one', - pandoc.Para 'two' - }, - elem - ) + test('pandoc.Str is a function', function () + assert.are_equal(type(pandoc.Str), 'function') end), - test('access Attr via property `attr`', function () - local div = pandoc.Div('word', {'my-div', {'sample'}}) - assert.are_equal(div.attr, pandoc.Attr{'my-div', {'sample'}}) - assert.are_equal(type(div.attr), 'userdata') - - div.attr = pandoc.Attr{'my-other-div', {'example'}} - assert.are_equal( - pandoc.Div('word', {'my-other-div', {'example'}}), - div - ) - end) - }, - group 'Header' { - test('access inlines via property `content`', function () - local header = pandoc.Header(1, 'test') - assert.are_same(header.content, {pandoc.Str 'test'}) - - header.content = {'new text'} - assert.are_equal(header, pandoc.Header(1, {'new text'})) + test('pandoc.Strikeout is a function', function () + assert.are_equal(type(pandoc.Strikeout), 'function') end), - test('access Attr via property `attr`', function () - local header = pandoc.Header(1, 'test', {'my-test'}) - assert.are_same(header.attr, pandoc.Attr{'my-test'}) - - header.attr = 'second-test' - assert.are_equal(header, pandoc.Header(1, 'test', 'second-test')) + test('pandoc.Strong is a function', function () + assert.are_equal(type(pandoc.Strong), 'function') end), - test('access level via property `level`', function () - local header = pandoc.Header(3, 'test') - assert.are_same(header.level, 3) - - header.level = 2 - assert.are_equal(header, pandoc.Header(2, 'test')) + test('pandoc.Subscript is a function', function () + assert.are_equal(type(pandoc.Subscript), 'function') end), - }, - group 'LineBlock' { - test('access lines via property `content`', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - assert.are_equal(#lineblock.content, 2) -- has two lines - assert.are_same(lineblock.content[2][1], pandoc.Str 'Berkeley') - end), - test('modifying `content` alter the element', function () - local spc = pandoc.Space() - local lineblock = pandoc.LineBlock{ - {'200', spc, 'Main', spc, 'St.'}, - {'Berkeley', spc, 'CA', spc, '94718'} - } - lineblock.content[1][1] = '404' - assert.are_same( - lineblock:clone().content[1], - {pandoc.Str '404', spc, pandoc.Str 'Main', spc, pandoc.Str 'St.'} - ) - - lineblock.content = {{'line1'}, {'line2'}} - assert.are_same( - lineblock:clone(), - pandoc.LineBlock{ - {pandoc.Str 'line1'}, - {pandoc.Str 'line2'} - } - ) - end) - }, - group 'OrderedList' { - test('access items via property `content`', function () - local para = pandoc.Plain 'one' - local olist = pandoc.OrderedList{{para}} - assert.are_same({{para}}, olist.content) - end), - test('forgiving constructor', function () - local plain = pandoc.Plain 'old' - local olist = pandoc.OrderedList({plain}, {3, 'Example', 'Period'}) - local listAttribs = pandoc.ListAttributes(3, 'Example', 'Period') - assert.are_same(olist.listAttributes, listAttribs) - end), - test('has list attribute aliases', function () - local olist = pandoc.OrderedList({}, {4, 'Decimal', 'OneParen'}) - assert.are_equal(olist.start, 4) - assert.are_equal(olist.style, 'Decimal') - assert.are_equal(olist.delimiter, 'OneParen') - end) - }, - group 'Para' { - test('access inline via property `content`', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), 'Sylt!'} - assert.are_same( - para.content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - ) + test('pandoc.Superscript is a function', function () + assert.are_equal(type(pandoc.Superscript), 'function') end), - test('modifying `content` changes the element', function () - local para = pandoc.Para{'Moin, ', pandoc.Space(), pandoc.Str 'Sylt!'} - - para.content[3] = 'Hamburg!' - assert.are_same( - para:clone().content, - {pandoc.Str 'Moin, ', pandoc.Space(), pandoc.Str 'Hamburg!'} - ) - - para.content = 'Huh' - assert.are_same( - para:clone().content, - {pandoc.Str 'Huh'} - ) + test('pandoc.Underline is a function', function () + assert.are_equal(type(pandoc.Underline), 'function') end), }, - group 'RawBlock' { - test('access raw content via property `text`', function () - local raw = pandoc.RawBlock('markdown', '- one') - assert.are_equal(type(raw.text), 'string') - assert.are_equal(raw.text, '- one') - - raw.text = '+ one' - assert.are_equal(raw, pandoc.RawBlock('markdown', '+ one')) + group "Block elements" { + test('pandoc.BlockQuote is a function', function () + assert.are_equal(type(pandoc.BlockQuote), 'function') end), - test('access Format via property `format`', function () - local raw = pandoc.RawBlock('markdown', '* hi') - assert.are_equal(type(raw.format), 'string') - assert.are_equal(raw.format, 'markdown') - - raw.format = 'org' - assert.are_equal(pandoc.RawBlock('org', '* hi'), raw) - end) - }, - group 'Table' { - test('access Attr via property `attr`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-tbl', {'a'}}) - assert.are_equal(tbl.attr, pandoc.Attr{'my-tbl', {'a'}}) - - tbl.attr = pandoc.Attr{'my-other-tbl', {'b'}} - assert.are_equal( - pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}, - {'my-other-tbl', {'b'}}), - tbl - ) + test('pandoc.BulletList is a function', function () + assert.are_equal(type(pandoc.BulletList), 'function') end), - test('access caption via property `caption`', function () - local caption = {long = {pandoc.Plain 'cap'}} - local tbl = pandoc.Table(caption, {}, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.caption, {long = {pandoc.Plain 'cap'}}) - - tbl.caption.short = 'brief' - tbl.caption.long = {pandoc.Plain 'extended'} - - local new_caption = { - short = 'brief', - long = {pandoc.Plain 'extended'} - } - assert.are_equal( - pandoc.Table(new_caption, {}, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.CodeBlock is a function', function () + assert.are_equal(type(pandoc.CodeBlock), 'function') end), - test('access column specifiers via property `colspecs`', function () - local colspecs = {{pandoc.AlignCenter, 1}} - local tbl = pandoc.Table({long = {}}, colspecs, {{}, {}}, {}, {{}, {}}) - assert.are_same(tbl.colspecs, colspecs) - - tbl.colspecs[1][1] = pandoc.AlignRight - tbl.colspecs[1][2] = nil - - local new_colspecs = {{pandoc.AlignRight}} - assert.are_equal( - pandoc.Table({long = {}}, new_colspecs, {{}, {}}, {}, {{}, {}}), - tbl - ) + test('pandoc.DefinitionList is a function', function () + assert.are_equal(type(pandoc.DefinitionList), 'function') end), - test('access table head via property `head`', function () - local head = {pandoc.Attr{'tbl-head'}, {}} - local tbl = pandoc.Table({long = {}}, {}, head, {}, {{}, {}}) - assert.are_same(tbl.head, head) - - tbl.head[1] = pandoc.Attr{'table-head'} - - local new_head = {'table-head', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, new_head, {}, {{}, {}}), - tbl - ) + test('pandoc.Div is a function', function () + assert.are_equal(type(pandoc.Div), 'function') end), - test('access table head via property `head`', function () - local foot = {{id = 'tbl-foot'}, {}} - local tbl = pandoc.Table({long = {}}, {}, {{}, {}}, {}, foot) - assert.are_same(tbl.foot, {pandoc.Attr('tbl-foot'), {}}) - - tbl.foot[1] = pandoc.Attr{'table-foot'} - - local new_foot = {'table-foot', {}} - assert.are_equal( - pandoc.Table({long = {}}, {}, {{}, {}}, {}, new_foot), - tbl - ) - end) - }, + test('pandoc.Header is a function', function () + assert.are_equal(type(pandoc.Header), 'function') + end), + test('pandoc.LineBlock is a function', function () + assert.are_equal(type(pandoc.LineBlock), 'function') + end), + test('pandoc.Null is a function', function () + assert.are_equal(type(pandoc.Null), 'function') + end), + test('pandoc.OrderedList is a function', function () + assert.are_equal(type(pandoc.OrderedList), 'function') + end), + test('pandoc.Para is a function', function () + assert.are_equal(type(pandoc.Para), 'function') + end), + test('pandoc.Plain is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.RawBlock is a function', function () + assert.are_equal(type(pandoc.Plain), 'function') + end), + test('pandoc.Table is a function', function () + assert.are_equal(type(pandoc.Table), 'function') + end), + } }, group 'MetaValue elements' { test('MetaList elements behave like lists', function () @@ -724,12 +133,6 @@ return { assert.are_equal(type(metalist.insert), 'function') assert.are_equal(type(metalist.remove), 'function') end), - test('MetaList, MetaMap, MetaInlines, MetaBlocks have `t` tag', function () - assert.are_equal((pandoc.MetaList{}).t, 'MetaList') - assert.are_equal((pandoc.MetaMap{}).t, 'MetaMap') - assert.are_equal((pandoc.MetaInlines{}).t, 'MetaInlines') - assert.are_equal((pandoc.MetaBlocks{}).t, 'MetaBlocks') - end), test('`tag` is an alias for `t``', function () assert.are_equal((pandoc.MetaList{}).tag, (pandoc.MetaList{}).t) assert.are_equal((pandoc.MetaMap{}).tag, (pandoc.MetaMap{}).t) @@ -756,81 +159,6 @@ return { end), }, group 'Other types' { - group 'Citation' { - test('checks equality by comparing Haskell values', function() - assert.are_equal( - pandoc.Citation('a', pandoc.NormalCitation), - pandoc.Citation('a', pandoc.NormalCitation) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('a', pandoc.AuthorInText) - ) - assert.is_falsy( - pandoc.Citation('a', pandoc.NormalCitation) == - pandoc.Citation('b', pandoc.NormalCitation) - ) - end), - }, - group 'SimpleTable' { - test('can access properties', function () - local spc = pandoc.Space() - local caption = {pandoc.Str 'Languages', spc, pandoc.Str 'overview.'} - local aligns = {pandoc.AlignDefault, pandoc.AlignDefault} - local widths = {0, 0} -- let pandoc determine col widths - local headers = {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}} - local rows = { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - local simple_table = pandoc.SimpleTable( - caption, - aligns, - widths, - headers, - rows - ) - assert.are_same(simple_table.caption, caption) - assert.are_same(simple_table.aligns, aligns) - assert.are_same(simple_table.widths, widths) - assert.are_same(simple_table.headers, headers) - assert.are_same(simple_table.rows, rows) - end), - test('can modify properties', function () - local new_table = pandoc.SimpleTable( - {'Languages'}, - {pandoc.AlignDefault, pandoc.AlignDefault}, - {0.5, 0.5}, - {{pandoc.Plain({pandoc.Str "Language"})}, - {pandoc.Plain({pandoc.Str "Typing"})}}, - { - {{pandoc.Plain "Haskell"}, {pandoc.Plain "static"}}, - {{pandoc.Plain "Lua"}, {pandoc.Plain "Dynamic"}}, - } - ) - - new_table.caption = {pandoc.Str 'Good', pandoc.Space(), - pandoc.Str 'languages'} - new_table.aligns[1] = pandoc.AlignLeft - new_table.widths = {0, 0} - new_table.headers[2] = {pandoc.Plain{pandoc.Str 'compiled/interpreted'}} - new_table.rows[1][2] = {pandoc.Plain{pandoc.Str 'both'}} - new_table.rows[2][2] = {pandoc.Plain{pandoc.Str 'interpreted'}} - - local expected_table = pandoc.SimpleTable( - {pandoc.Str 'Good', pandoc.Space(), pandoc.Str 'languages'}, - {pandoc.AlignLeft, pandoc.AlignDefault}, - {0, 0}, - {{pandoc.Plain 'Language'}, {pandoc.Plain 'compiled/interpreted'}}, - { - {{pandoc.Plain 'Haskell'}, {pandoc.Plain 'both'}}, - {{pandoc.Plain 'Lua'}, {pandoc.Plain 'interpreted'}} - } - ) - assert.are_same(expected_table, new_table) - end) - }, group 'ReaderOptions' { test('returns a userdata value', function () local opts = pandoc.ReaderOptions {} -- cgit v1.2.3 From fa838deefc6badc62b9ca4d93aba55e9fbd747ec Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 29 Nov 2021 18:12:30 +0100 Subject: Lua: remove `pandoc.utils.text` (#7720) The new `pandoc.Inlines` function behaves identical on string input, but allows other Inlines-like arguments as well. The `pandoc.utils.text` function could be written as function pandoc.utils.text (x) assert(type(x) == 'string') return pandoc.Inlines(x) end --- doc/lua-filters.md | 18 ------------------ src/Text/Pandoc/Lua/Module/Utils.hs | 8 -------- test/lua/module/pandoc-utils.lua | 28 ---------------------------- 3 files changed, 54 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index ff56e1a8e..ac682a90d 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3121,24 +3121,6 @@ Usage: -- outputs "Moin" print(pandoc.utils.stringify(inline)) -### text {#pandoc.utils.text} - -`text (words)` - -Converts a string to `Inlines`, treating interword spaces as -`Space`s or `SoftBreak`s. If you want a single `Str` with literal -spaces, use `pandoc.Str`. - -Parameters: - -`words` -: markup-less text (string) - -Returns: - -- List of inline elements split into words (Inlines) - - ### to\_roman\_numeral {#pandoc.utils.to_roman_numeral} `to_roman_numeral (integer)` diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 917f2e627..8bb185500 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -115,14 +115,6 @@ documentedModule = Module <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" - , defun "text" - ### liftPure (B.toList . B.text) - <#> parameter peekText "string" "words" "markup-less inlines text" - =#> functionResult pushInlines "Inlines" "list of inline elements" - #? ("Converts a string to `Inlines`, treating interword spaces as " <> - "`Space`s or `SoftBreak`s. If you want a `Str` with literal " <> - "spaces, use `pandoc.Str`.") - , defun "from_simple_table" ### from_simple_table <#> parameter peekSimpleTable "SimpleTable" "simple_tbl" "" diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 21f550177..9bd903f2d 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -82,34 +82,6 @@ return { end) }, - group 'text' { - test('string is converted to inlines', function () - local expected = { - pandoc.Str 'Madness', pandoc.Space(), pandoc.Str '-', pandoc.Space(), - pandoc.Str 'Our', pandoc.Space(), pandoc.Str 'House' - } - assert.are_same(pandoc.utils.text('Madness - Our House'), expected) - end), - test('tabs are treated as space', function () - local expected = { - pandoc.Str 'Linkin', pandoc.Space(), pandoc.Str 'Park', pandoc.Space(), - pandoc.Str '-', pandoc.Space(), pandoc.Str 'Papercut' - } - assert.are_same(pandoc.utils.text('Linkin Park\t-\tPapercut'), expected) - end), - test('newlines are treated as softbreaks', function () - local expected = { - pandoc.Str 'Porcupine', pandoc.Space(), pandoc.Str 'Tree', - pandoc.SoftBreak(), pandoc.Str '-', pandoc.SoftBreak(), - pandoc.Str 'Blackest', pandoc.Space(), pandoc.Str 'Eyes' - } - assert.are_same( - pandoc.utils.text('Porcupine Tree\n-\nBlackest Eyes'), - expected - ) - end), - }, - group 'to_roman_numeral' { test('convertes number', function () assert.are_equal('MDCCCLXXXVIII', utils.to_roman_numeral(1888)) -- cgit v1.2.3 From 7a70b87facffe5f2daaaa58af9fadad89b81a9e9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 17 Dec 2021 17:32:28 +0100 Subject: Lua: add function `pandoc.utils.references` List with all cited references of a document. Closes: #7752 --- doc/lua-filters.md | 32 ++++++++++ pandoc.cabal | 1 + src/Text/Pandoc/Lua/Marshal/Reference.hs | 101 +++++++++++++++++++++++++++++++ src/Text/Pandoc/Lua/Module/Utils.hs | 14 +++++ 4 files changed, 148 insertions(+) create mode 100644 src/Text/Pandoc/Lua/Marshal/Reference.hs (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 7b73dd9c5..93595a814 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -3301,6 +3301,38 @@ Usage: } local newblocks = pandoc.utils.make_sections(true, 1, blocks) +### references {#pandoc.references} + +`references (doc)` + +Get references defined inline in the metadata and via an external +bibliography. Only references that are actually cited in the +document (either with a genuine citation or with `nocite`) are +returned. URL variables are converted to links. + +The structure used represent reference values corresponds to that +used in CSL JSON; the return value can be use as `references` +metadata, which is one of the values used by pandoc and citeproc +when generating bibliographies. + +Parameters: + +`doc`: +: document ([Pandoc](#type-pandoc)) + +Returns: + +- list of references. (table) + +Usage: + + -- Include all cited references in document + function Pandoc (doc) + doc.meta.references = pandoc.utils.references(doc) + doc.meta.bibliography = nil + return doc + end + ### run\_json\_filter {#pandoc.utils.run_json_filter} `run_json_filter (doc, filter[, args])` diff --git a/pandoc.cabal b/pandoc.cabal index 13db955b9..b09b19144 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -697,6 +697,7 @@ library Text.Pandoc.Lua.Marshal.Context, Text.Pandoc.Lua.Marshal.PandocError, Text.Pandoc.Lua.Marshal.ReaderOptions, + Text.Pandoc.Lua.Marshal.Reference, Text.Pandoc.Lua.Marshal.Sources, Text.Pandoc.Lua.Module.MediaBag, Text.Pandoc.Lua.Module.Pandoc, diff --git a/src/Text/Pandoc/Lua/Marshal/Reference.hs b/src/Text/Pandoc/Lua/Marshal/Reference.hs new file mode 100644 index 000000000..51501836f --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshal/Reference.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua.Marshaling.ReaderOptions + Copyright : © 2012-2021 John MacFarlane + © 2017-2021 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Marshal citeproc 'Reference' values. +-} +module Text.Pandoc.Lua.Marshal.Reference + ( pushReference + ) where + +import Citeproc.Types + ( Date (..), DateParts (..), ItemId (..), Name (..), Reference (..) + , Val (..), Variable, fromVariable + ) +import Control.Monad (forM_) +import HsLua hiding (Name, Reference, pushName, peekName) +import Text.Pandoc.Builder (Inlines, toList) +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) +pushReference reference = do + pushAsTable [ ("id", pushItemId . referenceId) + , ("type", pushText . referenceType) + ] + reference + forM_ (Map.toList $ referenceVariables reference) $ \(var, val) -> do + pushVariable var + pushVal val + rawset (nth 3) + +-- | Pushes an 'ItemId' as a string. +pushItemId :: Pusher e ItemId +pushItemId = pushText . unItemId + +-- | Pushes a person's 'Name' as a table. +pushName :: LuaError e => Pusher e Name +pushName = pushAsTable + [ ("family" , pushTextOrNil . nameFamily) + , ("given" , pushTextOrNil . nameGiven) + , ("dropping-particle" , pushTextOrNil . nameDroppingParticle) + , ("non-dropping-particle" , pushTextOrNil . nameNonDroppingParticle) + , ("suffix" , pushTextOrNil . nameSuffix) + , ("literal" , pushTextOrNil . nameLiteral) + , ("comma-suffix" , pushBool . nameCommaSuffix) + , ("static-ordering" , pushBool . nameStaticOrdering) + ] + where + pushTextOrNil = \case + Nothing -> pushnil + Just xs -> pushText xs + +-- | Pushes a 'Variable' as string. +pushVariable :: Pusher e Variable +pushVariable = pushText . fromVariable + +-- | Pushes a 'Val', i.e., a variable value. +pushVal :: LuaError e => Pusher e (Val Inlines) +pushVal = \case + TextVal t -> pushText t + FancyVal inlns -> pushInlines $ toList inlns + NumVal i -> pushIntegral i + NamesVal names -> pushPandocList pushName names + DateVal date -> pushDate date + +-- | Pushes a 'Date' as table. +pushDate :: LuaError e => Pusher e Date +pushDate = pushAsTable + [ ("date-parts", pushPandocList pushDateParts . dateParts) + , ("circa", pushBool . dateCirca) + , ("season", maybe pushnil pushIntegral . dateSeason) + , ("literal", maybe pushnil pushText . dateLiteral) + ] + where + -- date parts are integers, but we push them as strings, as meta + -- values can't handle integers yet. + pushDateParts (DateParts dp) = pushPandocList (pushString . show) 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/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 8bb185500..6d0130dc2 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -25,9 +25,11 @@ import Data.Version (Version) import HsLua as Lua import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) +import Text.Pandoc.Citeproc (getReferences) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.Reference import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA @@ -95,6 +97,18 @@ documentedModule = Module =#> functionResult pushVersion "Version" "new Version object" #? "Creates a Version object." + , defun "references" + ### (unPandocLua . getReferences Nothing) + <#> parameter peekPandoc "Pandoc" "doc" "document" + =#> functionResult (pushPandocList pushReference) "table" + "lift of references" + #? mconcat + [ "Get references defined inline in the metadata and via an external " + , "bibliography. Only references that are actually cited in the " + , "document (either with a genuine citation or with `nocite`) are " + , "returned. URL variables are converted to links." + ] + , defun "run_json_filter" ### (\doc filterPath margs -> do args <- case margs of -- cgit v1.2.3 From c90802d7d85ba2ae98492701b30cc37bde757b83 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 09:48:54 +0100 Subject: Lua: fix return types of `blocks_to_inlines`, `make_sections` Ensures the returned lists have the correct type (`Inlines` and `Blocks`, respectively). --- src/Text/Pandoc/Lua/Module/Utils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 6d0130dc2..439a9a50b 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -57,7 +57,7 @@ documentedModule = Module "blocks" "" <#> optionalParameter (peekList peekInline) "list of inlines" "inline" "" - =#> functionResult (pushPandocList pushInline) "list of inlines" "" + =#> functionResult pushInlines "list of inlines" "" , defun "equals" ### liftPure2 (==) @@ -72,7 +72,7 @@ documentedModule = Module "integer or nil" "baselevel" "" <#> parameter (peekList peekBlock) "list of blocks" "blocks" "document blocks to process" - =#> functionResult (pushPandocList pushBlock) "list of Blocks" + =#> functionResult pushBlocks "list of Blocks" "processes blocks" , defun "normalize_date" -- cgit v1.2.3 From d7cab5198269fbbdbc40f54a2ad7aeb83fee619f Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 09:40:23 +0100 Subject: Lua: add new library function `pandoc.utils.type`. The function behaves like the default `type` function from Lua's standard library, but is aware of pandoc userdata types. A typical use-case would be to determine the type of a metadata value. --- doc/lua-filters.md | 36 ++++++++++++++++++++++++++++++++- src/Text/Pandoc/Lua/Module/Utils.hs | 12 +++++++++++ test/lua/module/pandoc-utils.lua | 40 +++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 901fd6be8..e5ea90104 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -1863,7 +1863,8 @@ Fields: Column alignment and width specification for a single table column. -This is a pair with the following components: +This is a pair, i.e., a plain table, with the following +components: 1. cell alignment ([Alignment]). 2. table column width, as a fraction of the total table width @@ -3507,6 +3508,39 @@ Usage: -- create normal table block again table = pandoc.utils.from_simple_table(simple) +### type {#pandoc.utils.type} + +`type (value)` + +Pandoc-friendly version of Lua's default `type` function, +returning the type of a value. This function works with all types +listed in section [Lua type reference][], except if noted +otherwise. + +The function works by checking the metafield `__name`. If the +argument has a string-valued metafield `__name`, then it returns +that string. Otherwise it behaves just like the normal `type` +function. + +Parameters: + +`value` +: any Lua value + +Returns: + +- type of the given value (string) + +Usage: + + -- Prints one of 'string', 'boolean', 'Inlines', 'Blocks', + -- 'table', and 'nil', corresponding to the Haskell constructors + -- MetaString, MetaBool, MetaInlines, MetaBlocks, MetaMap, + -- and an unset value, respectively. + function Meta (meta) + print('type of metavalue `author`:', pandoc.utils.type(meta.author)) + end + # Module pandoc.mediabag The `pandoc.mediabag` module allows accessing pandoc's media diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 439a9a50b..c1bb42410 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -21,6 +21,7 @@ import Control.Applicative ((<|>)) import Control.Monad ((<$!>)) import Data.Data (showConstr, toConstr) import Data.Default (def) +import Data.Maybe (fromMaybe) import Data.Version (Version) import HsLua as Lua import HsLua.Class.Peekable (PeekError) @@ -145,6 +146,17 @@ documentedModule = Module <#> parameter peekTable "Block" "tbl" "a table" =#> functionResult pushSimpleTable "SimpleTable" "SimpleTable object" #? "Converts a table into an old/simple table." + + , defun "type" + ### (\idx -> getmetafield idx "__name" >>= \case + TypeString -> fromMaybe mempty <$> tostring top + _ -> ltype idx >>= typename) + <#> parameter pure "any" "object" "" + =#> functionResult pushByteString "string" "type of the given value" + #? ("Pandoc-friendly version of Lua's default `type` function, " <> + "returning the type of a value. If the argument has a " <> + "string-valued metafield `__name`, then it gives that string. " <> + "Otherwise it behaves just like the normal `type` function.") ] } diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 7a43e9286..104adfe4c 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -116,6 +116,46 @@ return { end) }, + group 'type' { + test('nil', function () + assert.are_equal(utils.type(nil), 'nil') + end), + test('boolean', function () + assert.are_equal(utils.type(true), 'boolean') + assert.are_equal(utils.type(false), 'boolean') + end), + test('number', function () + assert.are_equal(utils.type(5), 'number') + assert.are_equal(utils.type(-3.02), 'number') + end), + test('string', function () + assert.are_equal(utils.type(''), 'string') + assert.are_equal(utils.type('asdf'), 'string') + end), + test('plain table', function () + assert.are_equal(utils.type({}), 'table') + end), + test('List', function () + assert.are_equal(utils.type(pandoc.List{}), 'List') + end), + test('Inline', function () + assert.are_equal(utils.type(pandoc.Str 'a'), 'Inline') + assert.are_equal(utils.type(pandoc.Emph 'emphasized'), 'Inline') + end), + test('Inlines', function () + assert.are_equal(utils.type(pandoc.Inlines{pandoc.Str 'a'}), 'Inlines') + assert.are_equal(utils.type(pandoc.Inlines{pandoc.Emph 'b'}), 'Inlines') + end), + test('Blocks', function () + assert.are_equal(utils.type(pandoc.Para 'a'), 'Block') + assert.are_equal(utils.type(pandoc.CodeBlock 'true'), 'Block') + end), + test('Inlines', function () + assert.are_equal(utils.type(pandoc.Blocks{'a'}), 'Blocks') + assert.are_equal(utils.type(pandoc.Blocks{pandoc.CodeBlock 'b'}), 'Blocks') + end), + }, + group 'to_simple_table' { test('convertes Table', function () function simple_cell (blocks) -- cgit v1.2.3 From 17a32a99a5eefadc5ebe66d441b6c4f7a0d2f438 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 18:53:37 +0100 Subject: Lua: simplify and deprecate function `pandoc.utils.equals` The function is no longer required for element comparisons; it is now an alias for the `==` operator. --- cabal.project | 2 +- doc/lua-filters.md | 36 +++++++++++++++++++++--------------- src/Text/Pandoc/Lua/Module/Utils.hs | 6 +++--- stack.yaml | 2 +- 4 files changed, 26 insertions(+), 20 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/cabal.project b/cabal.project index 8e56ca0a4..f0365d5da 100644 --- a/cabal.project +++ b/cabal.project @@ -6,7 +6,7 @@ constraints: aeson >= 2.0.1.0 source-repository-package type: git location: https://github.com/pandoc/pandoc-lua-marshal - tag: 45e53d9dce37d20f8e30e0d297a43c5b4c4a6831 + tag: f81ec19006cc4d0476f199d1fb913bac4af0a0d8 source-repository-package type: git diff --git a/doc/lua-filters.md b/doc/lua-filters.md index e5ea90104..af3342826 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -831,8 +831,8 @@ Usage: Pandoc document Values of this type can be created with the -[`pandoc.Pandoc`](#pandoc.pandoc) constructor. Object equality is -determined via [`pandoc.utils.equals`]. +[`pandoc.Pandoc`](#pandoc.pandoc) constructor. Pandoc values are +equal in Lua if and only if they are equal in Haskell. `blocks` : document content ([List] of [Blocks]) @@ -876,8 +876,8 @@ Meta information on a document; string-indexed collection of [MetaValues]. Values of this type can be created with the -[`pandoc.Meta`](#pandoc.meta) constructor. Object equality is -determined via [`pandoc.utils.equals`]. +[`pandoc.Meta`](#pandoc.meta) constructor. Meta values are equal +in Lua if and only if they are equal in Haskell. ## MetaValue {#type-metavalue} @@ -909,7 +909,8 @@ or `pandoc.Blocks`. ## Block {#type-block} -Object equality is determined via [`pandoc.utils.equals`]. +Block values are equal in Lua if and only if they are equal in +Haskell. ### Common methods @@ -1292,8 +1293,8 @@ Usage: ## Inline {#type-inline} -Object equality is determined by checking the Haskell -representation for equality. +Inline values are equal in Lua if and only if they are equal in +Haskell. ### Common methods @@ -1741,7 +1742,7 @@ Result: Usage: - -- returns `pandoc.Inlines{pandoc.SmallCaps('SPQR)}` + -- returns `pandoc.Inlines{pandoc.SmallCaps('SPQR')}` return pandoc.Inlines{pandoc.Emph('spqr')}:walk { Str = function (s) return string.upper(s.text) end, Emph = function (e) return pandoc.SmallCaps(e.content) end, @@ -1766,7 +1767,8 @@ This also works when using the `attr` setter: local span = pandoc.Span 'text' span.attr = {id = 'text', class = 'a b', other_attribute = '1'} -Object equality is determined via [`pandoc.utils.equals`]. +Attr values are equal in Lua if and only if they are equal in +Haskell. Fields: @@ -1784,6 +1786,9 @@ Fields: List of key/value pairs. Values can be accessed by using keys as indices to the list table. +Attributes values are equal in Lua if and only if they are equal +in Haskell. + ### Caption {#type-caption} The caption of a table, with an optional short caption. @@ -1835,7 +1840,8 @@ Single citation entry Values of this type can be created with the [`pandoc.Citation`](#pandoc.citation) constructor. -Object equality is determined via [`pandoc.utils.equals`]. +Citation values are equal in Lua if and only if they are equal in +Haskell. Fields: @@ -2115,7 +2121,7 @@ Values of this type can be created with the `must_be_at_least(actual, expected [, error_message])` Raise an error message if the actual version is older than the -expected version; does nothing if actual is equal to or newer +expected version; does nothing if `actual` is equal to or newer than the expected version. Parameters: @@ -2173,7 +2179,6 @@ Usage: [TableFoot]: #type-tablefoot [TableHead]: #type-tablehead [Version]: #type-version -[`pandoc.utils.equals`]: #pandoc.utils.equals # Module text @@ -3308,12 +3313,13 @@ Test equality of AST elements. Elements in Lua are considered equal if and only if the objects obtained by unmarshaling are equal. +**This function is deprecated.** Use the normal Lua `==` equality +operator instead. + Parameters: `element1`, `element2`: -: Objects to be compared. Acceptable input types are [Pandoc], - [Meta], [MetaValue], [Block], [Inline], [Attr], - [ListAttributes], and [Citation]. +: Objects to be compared (any type) Returns: diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index c1bb42410..24fd3402e 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -61,9 +61,9 @@ documentedModule = Module =#> functionResult pushInlines "list of inlines" "" , defun "equals" - ### liftPure2 (==) - <#> parameter peekAstElement "AST element" "elem1" "" - <#> parameter peekAstElement "AST element" "elem2" "" + ### equal + <#> parameter pure "AST element" "elem1" "" + <#> parameter pure "AST element" "elem2" "" =#> functionResult pushBool "boolean" "true iff elem1 == elem2" , defun "make_sections" diff --git a/stack.yaml b/stack.yaml index 702e3a780..492f39cf0 100644 --- a/stack.yaml +++ b/stack.yaml @@ -38,7 +38,7 @@ extra-deps: - git: https://github.com/jgm/ipynb.git commit: 00246af10885c2ad4413ace4f69a7e6c88297a08 - git: https://github.com/pandoc/pandoc-lua-marshal - commit: 45e53d9dce37d20f8e30e0d297a43c5b4c4a6831 + commit: f81ec19006cc4d0476f199d1fb913bac4af0a0d8 - git: https://github.com/jgm/commonmark-hs commit: 4d460b206e0b1872376db86cadf7a4567eeddaed subdir: commonmark-pandoc -- cgit v1.2.3 From 0bdf37315766eb4b785002ffaf38cdb724628e7a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 21 Dec 2021 21:50:13 +0100 Subject: Lua: simplify code of pandoc.utils.stringify Minor behavior change: plain strings nested in tables are now included in the result string. --- src/Text/Pandoc/Lua/Module/Utils.hs | 62 +++++++++++++------------------------ test/lua/module/pandoc-utils.lua | 7 ++--- 2 files changed, 25 insertions(+), 44 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index 24fd3402e..eabb2b532 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -24,7 +24,6 @@ import Data.Default (def) import Data.Maybe (fromMaybe) import Data.Version (Version) import HsLua as Lua -import HsLua.Class.Peekable (PeekError) import HsLua.Module.Version (peekVersionFuzzy, pushVersion) import Text.Pandoc.Citeproc (getReferences) import Text.Pandoc.Definition @@ -35,6 +34,7 @@ import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua)) import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map as Map import qualified Data.Text as T import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.Filter.JSON as JSONFilter @@ -126,8 +126,8 @@ documentedModule = Module =#> functionResult pushPandoc "Pandoc" "filtered document" , defun "stringify" - ### unPandocLua . stringify - <#> parameter peekAstElement "AST element" "elem" "some pandoc AST element" + ### stringify + <#> parameter pure "AST element" "elem" "some pandoc AST element" =#> functionResult pushText "string" "stringified element" , defun "from_simple_table" @@ -172,43 +172,25 @@ sha1 = defun "sha1" -- | Convert pandoc structure to a string with formatting removed. -- Footnotes are skipped (since we don't want their contents in link -- labels). -stringify :: AstElement -> PandocLua T.Text -stringify el = return $ case el of - PandocElement pd -> Shared.stringify pd - InlineElement i -> Shared.stringify i - BlockElement b -> Shared.stringify b - MetaElement m -> Shared.stringify m - CitationElement c -> Shared.stringify c - MetaValueElement m -> stringifyMetaValue m - _ -> mempty - -stringifyMetaValue :: MetaValue -> T.Text -stringifyMetaValue mv = case mv of - MetaBool b -> T.toLower $ T.pack (show b) - MetaString s -> s - _ -> Shared.stringify mv - -data AstElement - = PandocElement Pandoc - | MetaElement Meta - | BlockElement Block - | InlineElement Inline - | MetaValueElement MetaValue - | AttrElement Attr - | ListAttributesElement ListAttributes - | CitationElement Citation - deriving (Eq, Show) - -peekAstElement :: PeekError e => Peeker e AstElement -peekAstElement = retrieving "pandoc AST element" . choice - [ (fmap PandocElement . peekPandoc) - , (fmap InlineElement . peekInline) - , (fmap BlockElement . peekBlock) - , (fmap MetaValueElement . peekMetaValue) - , (fmap AttrElement . peekAttr) - , (fmap ListAttributesElement . peekListAttributes) - , (fmap MetaElement . peekMeta) - ] +stringify :: LuaError e => StackIndex -> LuaE e T.Text +stringify idx = forcePeek . retrieving "stringifyable element" $ + choice + [ (fmap Shared.stringify . peekPandoc) + , (fmap Shared.stringify . peekInline) + , (fmap Shared.stringify . peekBlock) + , (fmap Shared.stringify . peekCitation) + , (fmap stringifyMetaValue . peekMetaValue) + , (fmap (const "") . peekAttr) + , (fmap (const "") . peekListAttributes) + ] idx + where + stringifyMetaValue :: MetaValue -> T.Text + stringifyMetaValue mv = case mv of + MetaBool b -> T.toLower $ T.pack (show b) + MetaString s -> s + MetaList xs -> mconcat $ map stringifyMetaValue xs + MetaMap m -> mconcat $ map (stringifyMetaValue . snd) (Map.toList m) + _ -> Shared.stringify mv -- | Converts an old/simple table into a normal table block element. from_simple_table :: SimpleTable -> LuaE PandocError NumResults diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 73886346c..0475e96ec 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -181,12 +181,11 @@ return { end), test('Meta', function () local meta = pandoc.Meta{ - a = pandoc.Inlines 'a text', - b = 'movie', + a = pandoc.Inlines 'funny and ', + b = 'good movie', c = pandoc.List{pandoc.Inlines{pandoc.Str '!'}} } - -- nested MetaString values are not stringified. - assert.are_equal('a text!', utils.stringify(meta)) + assert.are_equal('funny and good movie!', utils.stringify(meta)) end), }, -- cgit v1.2.3 From fbd2c8e376eea5eccc0b799f8e48d10c7ab8b6d9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 25 Dec 2021 20:47:29 +0100 Subject: Lua: improve handling of empty caption, body by `from_simple_table` Create truly empty table caption and body when these are empty in the simple table. Fixes: #7776 --- src/Text/Pandoc/Lua/Module/Utils.hs | 4 ++-- test/lua/module/pandoc-utils.lua | 27 +++++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Lua/Module/Utils.hs') diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs index eabb2b532..02307cf7a 100644 --- a/src/Text/Pandoc/Lua/Module/Utils.hs +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -197,10 +197,10 @@ from_simple_table :: SimpleTable -> LuaE PandocError NumResults from_simple_table (SimpleTable capt aligns widths head' body) = do Lua.push $ Table nullAttr - (Caption Nothing [Plain capt]) + (Caption Nothing [Plain capt | not (null capt)]) (zipWith (\a w -> (a, toColWidth w)) aligns widths) (TableHead nullAttr [blockListToRow head' | not (null head') ]) - [TableBody nullAttr 0 [] $ map blockListToRow body] + [TableBody nullAttr 0 [] $ map blockListToRow body | not (null body)] (TableFoot nullAttr []) return (NumResults 1) where diff --git a/test/lua/module/pandoc-utils.lua b/test/lua/module/pandoc-utils.lua index 0475e96ec..4cf2c84a7 100644 --- a/test/lua/module/pandoc-utils.lua +++ b/test/lua/module/pandoc-utils.lua @@ -302,5 +302,32 @@ return { -- reversible assert.are_same(simple_table, utils.to_simple_table(tbl)) end), + test('empty caption', function () + local simple_table = pandoc.SimpleTable( + {}, + {pandoc.AlignDefault}, + {0}, + {{pandoc.Plain 'a'}}, + {{{pandoc.Plain 'b'}}} + ) + local tbl = utils.from_simple_table(simple_table) + assert.are_equal( + pandoc.Blocks{}, + tbl.caption.long + ) + assert.is_nil(tbl.caption.short) + end), + test('empty body', function () + local simple_table = pandoc.SimpleTable( + pandoc.Inlines('a nice caption'), + {pandoc.AlignDefault}, + {0}, + {{pandoc.Plain 'a'}}, + {} + ) + local tbl = utils.from_simple_table(simple_table) + tbl.bodies:map(print) + assert.are_same(pandoc.List(), tbl.bodies) + end), } } -- cgit v1.2.3