diff options
| author | Albert Krewinkel <albert@zeitkraut.de> | 2021-10-29 17:08:03 +0200 | 
|---|---|---|
| committer | Albert Krewinkel <albert@zeitkraut.de> | 2021-10-29 17:08:30 +0200 | 
| commit | f4d9b443d8b44b802d564a64280cbe9ea89dacc8 (patch) | |
| tree | 10fe1c4e9986e045c0537eb30901b499b210be91 | |
| parent | e1cf0ad1bef439da829068b4c5104d81692e860d (diff) | |
| download | pandoc-f4d9b443d8b44b802d564a64280cbe9ea89dacc8.tar.gz | |
Lua: use hslua module abstraction where possible
This will make it easier to generate module documentation in the future.
| -rw-r--r-- | data/pandoc.lua | 120 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Filter.hs | 33 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/AST.hs | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Marshaling/Attr.hs | 50 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/MediaBag.hs | 160 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Pandoc.hs | 258 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/System.hs | 44 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Types.hs | 56 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Module/Utils.hs | 26 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Packages.hs | 26 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/PandocLua.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Lua/Util.hs | 9 | ||||
| -rw-r--r-- | test/lua/module/pandoc.lua | 6 | 
13 files changed, 385 insertions, 412 deletions
| 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 <tarleb+pandoc@moltkeplatz.de> -   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 "<no output>" 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, | 
