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.

cabal.project

@@ -41,4 +41,3 @@ source-repository-package
 --   type: git
 --   location: https://github.com/jgm/ipynb.git
 --   tag: 1f1ddb29227335091a3a158b9aeeeb47a372c683
-

pandoc.cabal

@@ -551,10 +551,11 @@ library
                  file-embed            >= 0.0      && < 0.1,
                  filepath              >= 1.1      && < 1.5,
                  haddock-library       >= 1.10     && < 1.11,
-                 hslua                 >= 1.1      && < 1.4,
-                 hslua-module-path     >= 0.1.0    && < 0.2.0,
-                 hslua-module-system   >= 0.2      && < 0.3,
-                 hslua-module-text     >= 0.2.1    && < 0.4,
+                 hslua                 >= 2.0      && < 2.1,
+                 hslua-marshalling     >= 2.0      && < 2.1,
+                 hslua-module-path     >= 1.0      && < 1.1,
+                 hslua-module-system   >= 1.0      && < 1.1,
+                 hslua-module-text     >= 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,
@@ -775,11 +776,9 @@ library
                    Text.Pandoc.Lua.Init,
                    Text.Pandoc.Lua.Marshaling,
                    Text.Pandoc.Lua.Marshaling.AST,
-                   Text.Pandoc.Lua.Marshaling.AnyValue,
                    Text.Pandoc.Lua.Marshaling.CommonState,
                    Text.Pandoc.Lua.Marshaling.Context,
                    Text.Pandoc.Lua.Marshaling.List,
-                   Text.Pandoc.Lua.Marshaling.MediaBag,
                    Text.Pandoc.Lua.Marshaling.PandocError,
                    Text.Pandoc.Lua.Marshaling.ReaderOptions,
                    Text.Pandoc.Lua.Marshaling.SimpleTable,
@@ -847,14 +846,14 @@ test-suite test-pandoc
                   doctemplates      >= 0.10    && < 0.11,
                   exceptions        >= 0.8     && < 0.11,
                   filepath          >= 1.1     && < 1.5,
-                  hslua             >= 1.1     && < 1.4,
+                  hslua             >= 2.0     && < 2.1,
                   mtl               >= 2.2     && < 2.3,
                   pandoc-types      >= 1.22    && < 1.23,
                   process           >= 1.2.3   && < 1.7,
                   tasty             >= 0.11    && < 1.5,
                   tasty-golden      >= 2.3     && < 2.4,
                   tasty-hunit       >= 0.9     && < 0.11,
-                  tasty-lua         >= 0.2     && < 0.3,
+                  tasty-lua         >= 1.0     && < 1.1,
                   tasty-quickcheck  >= 0.8     && < 0.11,
                   text              >= 1.1.1.0  && < 1.3,
                   time              >= 1.5     && < 1.13,

src/Text/Pandoc/Lua/ErrorConversion.hs

@@ -1,6 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {- |
    Module      : Text.Pandoc.Lua.ErrorConversion
    Copyright   : © 2020-2021 Albert Krewinkel
@@ -13,49 +12,37 @@ Define how Lua errors are converted into @'PandocError'@ Haskell
 exceptions, and /vice versa/.
 -}
 module Text.Pandoc.Lua.ErrorConversion
-  ( errorConversion
+  ( addContextToException
   ) where
 
-import Foreign.Lua (Lua (..), NumResults)
+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 qualified Control.Monad.Catch as Catch
 import qualified Data.Text as T
-import qualified Foreign.Lua as Lua
+import qualified HsLua as Lua
 
--- | Conversions between Lua errors and Haskell exceptions, assuming
--- that all exceptions are of type @'PandocError'@.
-errorConversion :: Lua.ErrorConversion
-errorConversion = Lua.ErrorConversion
-  { Lua.addContextToException = addContextToException
-  , Lua.alternative           = alternative
-  , Lua.errorToException      = errorToException
-  , Lua.exceptionToError      = exceptionToError
-  }
+addContextToException :: ()
+addContextToException = undefined
 
--- | Convert a Lua error, which must be at the top of the stack, into a
--- @'PandocError'@, popping the value from the stack.
-errorToException :: forall a . Lua.State -> IO a
-errorToException l = Lua.unsafeRunWith l $ do
-  err <- peekPandocError Lua.stackTop
-  Lua.pop 1
-  Catch.throwM err
+-- | Retrieve a @'PandocError'@ from the Lua stack.
+popPandocError :: LuaE PandocError PandocError
+popPandocError = do
+  errResult <- runPeek $ peekPandocError top
+  case resultToEither errResult of
+    Right x -> return x
+    Left err -> return $ PandocLuaError (T.pack err)
 
--- | Try the first op -- if it doesn't succeed, run the second.
-alternative :: forall a . Lua a -> Lua a -> Lua a
-alternative x y = Catch.try x >>= \case
-  Left (_ :: PandocError) -> y
-  Right x' -> return x'
+-- Ensure conversions between Lua errors and 'PandocError' exceptions
+-- are possible.
+instance LuaError PandocError where
+  popException = popPandocError
+  pushException = pushPandocError
+  luaException = PandocLuaError . T.pack
 
--- | Add more context to an error
-addContextToException :: forall a . String -> Lua a -> Lua a
-addContextToException ctx op = op `Catch.catch` \case
-  PandocLuaError msg -> Catch.throwM $ PandocLuaError (T.pack ctx <> msg)
-  e -> Catch.throwM e
-
--- | Catch a @'PandocError'@ exception and raise it as a Lua error.
-exceptionToError :: Lua NumResults -> Lua NumResults
-exceptionToError op = op `Catch.catch` \e -> do
-  pushPandocError e
-  Lua.error
+instance PeekError PandocError where
+  messageFromException = \case
+    PandocLuaError m -> T.unpack m
+    err -> show err

src/Text/Pandoc/Lua/Filter.hs

@@ -1,4 +1,7 @@
 {-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE IncoherentInstances  #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
 {- |
 Module      : Text.Pandoc.Lua.Filter
 Copyright   : © 2012-2021 John MacFarlane,
@@ -19,43 +22,42 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
                               , module Text.Pandoc.Lua.Walk
                               ) where
 import Control.Applicative ((<|>))
-import Control.Monad (mplus, (>=>))
-import Control.Monad.Catch (finally, try)
+import Control.Monad (mplus, (>=>), (<$!>))
 import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
                   showConstr, toConstr, tyconUQname)
 import Data.Foldable (foldrM)
 import Data.List (foldl')
 import Data.Map (Map)
-import Data.Maybe (fromMaybe)
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+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.List (List (..))
+import Text.Pandoc.Lua.Marshaling.AST
+import Text.Pandoc.Lua.Marshaling.List (List (..), peekList')
 import Text.Pandoc.Lua.Walk (SingletonsList (..))
 import Text.Pandoc.Walk (Walkable (walkM))
 
 import qualified Data.Map.Strict as Map
-import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.Lua.Util as LuaUtil
 
 -- | Transform document using the filter defined in the given file.
-runFilterFile :: FilePath -> Pandoc -> Lua Pandoc
+runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc
 runFilterFile filterPath doc = do
-  top <- Lua.gettop
+  oldtop <- Lua.gettop
   stat <- LuaUtil.dofileWithTraceback filterPath
   if stat /= Lua.OK
-    then Lua.throwTopMessage
+    then Lua.throwErrorAsException
     else do
       newtop <- Lua.gettop
       -- Use the returned filters, or the implicitly defined global
       -- filter if nothing was returned.
-      luaFilters <- if newtop - top >= 1
-                    then Lua.peek Lua.stackTop
+      luaFilters <- if newtop - oldtop >= 1
+                    then Lua.peek Lua.top
                     else Lua.pushglobaltable *> fmap (:[]) Lua.popValue
       runAll luaFilters doc
 
-runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
+runAll :: [LuaFilter] -> Pandoc -> LuaE PandocError Pandoc
 runAll = foldr ((>=>) . walkMWithLuaFilter) return
 
 -- | Filter function stored in the registry
@@ -63,7 +65,7 @@ newtype LuaFilterFunction = LuaFilterFunction Lua.Reference
 
 -- | Collection of filter functions (at most one function per element
 -- constructor)
-newtype LuaFilter = LuaFilter (Map String LuaFilterFunction)
+newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction)
 
 instance Peekable LuaFilter where
   peek idx = do
@@ -79,19 +81,19 @@ instance Peekable LuaFilter where
           return $ case filterFn of
             Nothing -> acc
             Just fn -> Map.insert constr fn acc
-    LuaFilter <$> foldrM go Map.empty constrs
+    LuaFilter <$!> foldrM go Map.empty constrs
 
 -- | Register the function at the top of the stack as a filter function in the
 -- registry.
-registerFilterFunction :: Lua (Maybe LuaFilterFunction)
+registerFilterFunction :: LuaError e => LuaE e (Maybe LuaFilterFunction)
 registerFilterFunction = do
-  isFn <- Lua.isfunction Lua.stackTop
+  isFn <- Lua.isfunction Lua.top
   if isFn
     then Just . LuaFilterFunction <$> Lua.ref Lua.registryindex
     else Nothing <$ Lua.pop 1
 
 -- | Retrieve filter function from registry and push it to the top of the stack.
-pushFilterFunction :: LuaFilterFunction -> Lua ()
+pushFilterFunction :: LuaFilterFunction -> LuaE PandocError ()
 pushFilterFunction (LuaFilterFunction fnRef) =
   Lua.getref Lua.registryindex fnRef
 
@@ -99,58 +101,66 @@ pushFilterFunction (LuaFilterFunction fnRef) =
 -- element instead of a list, fetch that element as a singleton list. If the top
 -- of the stack is nil, return the default element that was passed to this
 -- function. If none of these apply, raise an error.
-elementOrList :: Peekable a => a -> Lua [a]
-elementOrList x = do
-  let topOfStack = Lua.stackTop
-  elementUnchanged <- Lua.isnil topOfStack
+elementOrList :: Peeker PandocError a -> a -> LuaE PandocError [a]
+elementOrList p x = do
+  elementUnchanged <- Lua.isnil top
   if elementUnchanged
-    then [x] <$ Lua.pop 1
-    else do
-       mbres <- peekEither topOfStack
-       case mbres of
-         Right res -> [res] <$ Lua.pop 1
-         Left _    -> Lua.peekList topOfStack `finally` Lua.pop 1
+    then [x] <$ pop 1
+    else forcePeek . (`lastly` pop 1) $ (((:[]) <$!> p top) <|> peekList p top)
+
+-- | Fetches a single element; returns the fallback if the value is @nil@.
+singleElement :: forall a e. (LuaError e) => Peeker e a -> a -> LuaE e a
+singleElement p x = do
+  elementUnchanged <- Lua.isnil top
+  if elementUnchanged
+    then x <$ Lua.pop 1
+    else forcePeek $ p top `lastly` pop 1
 
 -- | Pop and return a value from the stack; if the value at the top of
 -- the stack is @nil@, return the fallback element.
-popOption :: Peekable a => a -> Lua a
-popOption fallback = fromMaybe fallback . Lua.fromOptional <$> Lua.popValue
+popOption :: Peeker PandocError a -> a -> LuaE PandocError a
+popOption peeker fallback = forcePeek . (`lastly` pop 1) $
+  (fallback <$ peekNil top) <|> peeker top
 
 -- | Apply filter on a sequence of AST elements. Both lists and single
 -- value are accepted as filter function return values.
-runOnSequence :: (Data a, Peekable a, Pushable a)
-              => LuaFilter -> SingletonsList a -> Lua (SingletonsList a)
-runOnSequence (LuaFilter fnMap) (SingletonsList xs) =
+runOnSequence :: forall a. (Data a, Pushable a)
+              => Peeker PandocError a -> LuaFilter -> SingletonsList a
+              -> LuaE PandocError (SingletonsList a)
+runOnSequence peeker (LuaFilter fnMap) (SingletonsList xs) =
   SingletonsList <$> mconcatMapM tryFilter xs
  where
-  tryFilter :: (Data a, Peekable a, Pushable a) => a -> Lua [a]
+  tryFilter :: a -> LuaE PandocError [a]
   tryFilter x =
-    let filterFnName = showConstr (toConstr x)
-        catchAllName = tyconUQname $ dataTypeName (dataTypeOf x)
+    let filterFnName = fromString $ showConstr (toConstr x)
+        catchAllName = fromString . tyconUQname $ dataTypeName (dataTypeOf x)
     in case Map.lookup filterFnName fnMap <|> Map.lookup catchAllName fnMap of
-         Just fn -> runFilterFunction fn x *> elementOrList x
+         Just fn -> runFilterFunction fn x *> elementOrList peeker x
          Nothing -> return [x]
 
 -- | Try filtering the given value without type error corrections on
 -- the return value.
-runOnValue :: (Data a, Peekable a, Pushable a)
-           => String -> LuaFilter -> a -> Lua a
-runOnValue filterFnName (LuaFilter fnMap) x =
+runOnValue :: (Data a, Pushable a)
+           => Name -> Peeker PandocError a
+           -> LuaFilter -> a
+           -> LuaE PandocError a
+runOnValue filterFnName peeker (LuaFilter fnMap) x =
   case Map.lookup filterFnName fnMap of
-    Just fn -> runFilterFunction fn x *> popOption x
+    Just fn -> runFilterFunction fn x *> popOption peeker x
     Nothing -> return x
 
--- | Push a value to the stack via a lua filter function. The filter function is
--- called with given element as argument and is expected to return an element.
--- Alternatively, the function can return nothing or nil, in which case the
--- element is left unchanged.
-runFilterFunction :: Pushable a => LuaFilterFunction -> a -> Lua ()
+-- | Push a value to the stack via a Lua filter function. The filter
+-- function is called with the given element as argument and is expected
+-- to return an element. Alternatively, the function can return nothing
+-- or nil, in which case the element is left unchanged.
+runFilterFunction :: Pushable a
+                  => LuaFilterFunction -> a -> LuaE PandocError ()
 runFilterFunction lf x = do
   pushFilterFunction lf
   Lua.push x
   LuaUtil.callWithTraceback 1 1
 
-walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
+walkMWithLuaFilter :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc
 walkMWithLuaFilter f =
       walkInlines f
   >=> walkInlineLists f
@@ -162,92 +172,76 @@ walkMWithLuaFilter f =
 mconcatMapM :: (Monad m) => (a -> m [a]) -> [a] -> m [a]
 mconcatMapM f = fmap mconcat . mapM f
 
-hasOneOf :: LuaFilter -> [String] -> Bool
+hasOneOf :: LuaFilter -> [Name] -> Bool
 hasOneOf (LuaFilter fnMap) = any (`Map.member` fnMap)
 
-contains :: LuaFilter -> String -> Bool
+contains :: LuaFilter -> Name -> Bool
 contains (LuaFilter fnMap) = (`Map.member` fnMap)
 
-walkInlines :: Walkable (SingletonsList Inline) a => LuaFilter -> a -> Lua a
+walkInlines :: Walkable (SingletonsList Inline) a
+            => LuaFilter -> a -> LuaE PandocError a
 walkInlines lf =
-  let f :: SingletonsList Inline -> Lua (SingletonsList Inline)
-      f = runOnSequence lf
+  let f :: SingletonsList Inline -> LuaE PandocError (SingletonsList Inline)
+      f = runOnSequence peekInline lf
   in if lf `hasOneOf` inlineElementNames
      then walkM f
      else return
 
-walkInlineLists :: Walkable (List Inline) a => LuaFilter -> a -> Lua a
+walkInlineLists :: Walkable (List Inline) a
+                => LuaFilter -> a -> LuaE PandocError a
 walkInlineLists lf =
-  let f :: List Inline -> Lua (List Inline)
-      f = runOnValue listOfInlinesFilterName lf
+  let f :: List Inline -> LuaE PandocError (List Inline)
+      f = runOnValue listOfInlinesFilterName (peekList' peekInline) lf
   in if lf `contains` listOfInlinesFilterName
      then walkM f
      else return
 
-walkBlocks :: Walkable (SingletonsList Block) a => LuaFilter -> a -> Lua a
+walkBlocks :: Walkable (SingletonsList Block) a
+           => LuaFilter -> a -> LuaE PandocError a
 walkBlocks lf =
-  let f :: SingletonsList Block -> Lua (SingletonsList Block)
-      f = runOnSequence lf
+  let f :: SingletonsList Block -> LuaE PandocError (SingletonsList Block)
+      f = runOnSequence peekBlock lf
   in if lf `hasOneOf` blockElementNames
      then walkM f
      else return
 
-walkBlockLists :: Walkable (List Block) a => LuaFilter -> a -> Lua a
+walkBlockLists :: Walkable (List Block) a
+               => LuaFilter -> a -> LuaE PandocError a
 walkBlockLists lf =
-  let f :: List Block -> Lua (List Block)
-      f = runOnValue listOfBlocksFilterName lf
+  let f :: List Block -> LuaE PandocError (List Block)
+      f = runOnValue listOfBlocksFilterName (peekList' peekBlock) lf
   in if lf `contains` listOfBlocksFilterName
      then walkM f
      else return
 
-walkMeta :: LuaFilter -> Pandoc -> Lua Pandoc
+walkMeta :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc
 walkMeta lf (Pandoc m bs) = do
-  m' <- runOnValue "Meta" lf m
+  m' <- runOnValue "Meta" peekMeta lf m
   return $ Pandoc m' bs
 
-walkPandoc :: LuaFilter -> Pandoc -> Lua Pandoc
+walkPandoc :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc
 walkPandoc (LuaFilter fnMap) =
   case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of
-    Just fn -> \x -> runFilterFunction fn x *> singleElement x
+    Just fn -> \x -> runFilterFunction fn x *> singleElement peekPandoc x
     Nothing -> return
 
-constructorsFor :: DataType -> [String]
-constructorsFor x = map show (dataTypeConstrs x)
+constructorsFor :: DataType -> [Name]
+constructorsFor x = map (fromString . show) (dataTypeConstrs x)
 
-inlineElementNames :: [String]
+inlineElementNames :: [Name]
 inlineElementNames = "Inline" : constructorsFor (dataTypeOf (Str mempty))
 
-blockElementNames :: [String]
+blockElementNames :: [Name]
 blockElementNames = "Block" : constructorsFor (dataTypeOf (Para []))
 
-listOfInlinesFilterName :: String
+listOfInlinesFilterName :: Name
 listOfInlinesFilterName = "Inlines"
 
-listOfBlocksFilterName :: String
+listOfBlocksFilterName :: Name
 listOfBlocksFilterName = "Blocks"
 
-metaFilterName :: String
+metaFilterName :: Name
 metaFilterName = "Meta"
 
-pandocFilterNames :: [String]
+pandocFilterNames :: [Name]
 pandocFilterNames = ["Pandoc", "Doc"]
-
-singleElement :: Peekable a => a -> Lua a
-singleElement x = do
-  elementUnchanged <- Lua.isnil (-1)
-  if elementUnchanged
-    then x <$ Lua.pop 1
-    else do
-    mbres <- peekEither (-1)
-    case mbres of
-      Right res -> res <$ Lua.pop 1
-      Left err  -> do
-        Lua.pop 1
-        Lua.throwMessage
-          ("Error while trying to get a filter's return " <>
-           "value from Lua stack.\n" <> show err)
-
--- | Try to convert the value at the given stack index to a Haskell value.
--- Returns @Left@ with an error message on failure.
-peekEither :: Peekable a => StackIndex -> Lua (Either PandocError a)
-peekEither = try . Lua.peek

src/Text/Pandoc/Lua/Global.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings  #-}
 {- |
    Module      : Text.Pandoc.Lua
    Copyright   : Copyright © 2017-2021 Albert Krewinkel
@@ -14,19 +14,17 @@ module Text.Pandoc.Lua.Global
   , setGlobals
   ) where
 
-import Data.Data (Data)
-import Foreign.Lua (Lua, Peekable, Pushable)
-import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
-                            , metatableName)
+import HsLua as Lua
 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.Util (addFunction)
+import Text.Pandoc.Lua.Marshaling.CommonState (pushCommonState)
+import Text.Pandoc.Lua.Marshaling.ReaderOptions (pushReaderOptions)
 import Text.Pandoc.Options (ReaderOptions)
 
 import qualified Data.Text as Text
-import qualified Foreign.Lua as Lua
 
 -- | Permissible global Lua variables.
 data Global =
@@ -40,10 +38,10 @@ data Global =
   -- Cannot derive instance of Data because of CommonState
 
 -- | Set all given globals.
-setGlobals :: [Global] -> Lua ()
+setGlobals :: [Global] -> LuaE PandocError ()
 setGlobals = mapM_ setGlobal
 
-setGlobal :: Global -> Lua ()
+setGlobal :: Global -> LuaE PandocError ()
 setGlobal global = case global of
   -- This could be simplified if Global was an instance of Data.
   FORMAT format -> do
@@ -53,37 +51,24 @@ setGlobal global = case global of
     Lua.push pandocTypesVersion
     Lua.setglobal "PANDOC_API_VERSION"
   PANDOC_DOCUMENT doc -> do
-    Lua.push (LazyPandoc doc)
+    pushUD typePandocLazy  doc
     Lua.setglobal "PANDOC_DOCUMENT"
   PANDOC_READER_OPTIONS ropts -> do
-    Lua.push ropts
+    pushReaderOptions ropts
     Lua.setglobal "PANDOC_READER_OPTIONS"
   PANDOC_SCRIPT_FILE filePath -> do
     Lua.push filePath
     Lua.setglobal "PANDOC_SCRIPT_FILE"
   PANDOC_STATE commonState -> do
-    Lua.push commonState
+    pushCommonState commonState
     Lua.setglobal "PANDOC_STATE"
   PANDOC_VERSION              -> do
     Lua.push version
     Lua.setglobal "PANDOC_VERSION"
 
 -- | Readonly and lazy pandoc objects.
-newtype LazyPandoc = LazyPandoc Pandoc
-  deriving (Data)
-
-instance Pushable LazyPandoc where
-  push lazyDoc = pushAnyWithMetatable pushPandocMetatable lazyDoc
-   where
-    pushPandocMetatable = ensureUserdataMetatable (metatableName lazyDoc) $
-                          addFunction "__index" indexLazyPandoc
-
-instance Peekable LazyPandoc where
-  peek = Lua.peekAny
-
-indexLazyPandoc :: LazyPandoc -> String -> Lua Lua.NumResults
-indexLazyPandoc (LazyPandoc (Pandoc meta blks)) field = 1 <$
-  case field of
-    "blocks" -> Lua.push blks
-    "meta"   -> Lua.push meta
-    _        -> Lua.pushnil
+typePandocLazy :: LuaError e => DocumentedType e Pandoc
+typePandocLazy = deftype "Pandoc (lazy)" []
+  [ readonly "meta" "document metadata" (push, \(Pandoc meta _) -> meta)
+  , readonly "blocks" "content blocks" (push, \(Pandoc _ blocks) -> blocks)
+  ]

src/Text/Pandoc/Lua/Init.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {- |
    Module      : Text.Pandoc.Lua
    Copyright   : Copyright © 2017-2021 Albert Krewinkel
@@ -13,23 +14,23 @@ module Text.Pandoc.Lua.Init
   ) where
 
 import Control.Monad (when)
-import Control.Monad.Catch (try)
+import Control.Monad.Catch (throwM, try)
 import Control.Monad.Trans (MonadIO (..))
 import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
-import Foreign.Lua (Lua)
+import HsLua as Lua hiding (status, try)
 import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
-import Text.Pandoc.Class.PandocMonad (readDataFile, PandocMonad)
-import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Class.PandocMonad (PandocMonad, readDataFile)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
 import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
 import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)
-import Text.Pandoc.Lua.Util (throwTopMessageAsError')
-import qualified Foreign.Lua as Lua
+import qualified Data.Text as T
 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
 -- initialization.
-runLua :: (PandocMonad m, MonadIO m) => Lua a -> m (Either PandocError a)
+runLua :: (PandocMonad m, MonadIO m)
+       => LuaE PandocError a -> m (Either PandocError a)
 runLua luaOp = do
   enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8
   res <- runPandocLua . try $ do
@@ -52,9 +53,9 @@ initLuaState = do
     ModulePandoc.pushModule
     -- register as loaded module
     liftPandocLua $ do
-      Lua.pushvalue Lua.stackTop
-      Lua.getfield Lua.registryindex Lua.loadedTableRegistryField
-      Lua.setfield (Lua.nthFromTop 2) "pandoc"
+      Lua.pushvalue Lua.top
+      Lua.getfield Lua.registryindex Lua.loaded
+      Lua.setfield (Lua.nth 2) "pandoc"
       Lua.pop 1
     -- copy constructors into registry
     putConstructorsInRegistry
@@ -65,10 +66,12 @@ initLuaState = do
   loadInitScript scriptFile = do
     script <- readDataFile scriptFile
     status <- liftPandocLua $ Lua.dostring script
-    when (status /= Lua.OK) . liftPandocLua $
-      throwTopMessageAsError'
-      (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
-
+    when (status /= Lua.OK) . liftPandocLua $ do
+      err <- popException
+      let prefix = "Couldn't load '" <> T.pack scriptFile <> "':\n"
+      throwM . PandocLuaError . (prefix <>) $ case err of
+        PandocLuaError msg -> msg
+        _                  -> T.pack $ show err
 
 -- | AST elements are marshaled via normal constructor functions in the
 -- @pandoc@ module. However, accessing Lua globals from Haskell is
@@ -91,12 +94,12 @@ putConstructorsInRegistry = liftPandocLua $ do
   putInReg "List"  -- pandoc.List
   putInReg "SimpleTable"  -- helper for backward-compatible table handling
  where
-  constrsToReg :: Data a => a -> Lua ()
+  constrsToReg :: Data a => a -> LuaE PandocError ()
   constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf
 
-  putInReg :: String -> Lua ()
+  putInReg :: String -> LuaE PandocError ()
   putInReg name = do
     Lua.push ("pandoc." ++ name) -- name in registry
     Lua.push name -- in pandoc module
-    Lua.rawget (Lua.nthFromTop 3)
+    Lua.rawget (Lua.nth 3)
     Lua.rawset Lua.registryindex

src/Text/Pandoc/Lua/Marshaling.hs

@@ -17,3 +17,4 @@ 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 ()

src/Text/Pandoc/Lua/Marshaling/AST.hs

@@ -1,6 +1,8 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns         #-}
 {-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshaling.AST
    Copyright   : © 2012-2021 John MacFarlane
@@ -13,223 +15,254 @@
 Marshaling/unmarshaling instances for document AST elements.
 -}
 module Text.Pandoc.Lua.Marshaling.AST
-  ( LuaAttr (..)
-  , LuaListAttributes (..)
+  ( peekAttr
+  , peekBlock
+  , peekBlocks
+  , peekCaption
+  , peekCitation
+  , peekInline
+  , peekInlines
+  , peekListAttributes
+  , peekMeta
+  , peekMetaValue
+  , peekPandoc
+
+  , pushAttr
+  , pushBlock
+  , pushInline
+  , pushListAttributes
+  , pushMetaValue
+  , pushPandoc
   ) where
 
-import Control.Applicative ((<|>))
-import Control.Monad ((<$!>))
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import Control.Applicative ((<|>), optional)
+import Control.Monad ((<$!>), (>=>))
+import HsLua hiding (Operation (Div))
 import Text.Pandoc.Definition
-import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
+import Text.Pandoc.Lua.Util (pushViaConstr', pushViaConstructor)
 import Text.Pandoc.Lua.Marshaling.CommonState ()
 
-import qualified Control.Monad.Catch as Catch
-import qualified Foreign.Lua as Lua
+import qualified HsLua as Lua
 import qualified Text.Pandoc.Lua.Util as LuaUtil
 
 instance Pushable Pandoc where
-  push (Pandoc meta blocks) =
-    pushViaConstructor "Pandoc" blocks meta
+  push = pushPandoc
 
-instance Peekable Pandoc where
-  peek idx = defineHowTo "get Pandoc value" $! Pandoc
-    <$!> LuaUtil.rawField idx "meta"
-    <*>  LuaUtil.rawField idx "blocks"
+pushPandoc :: LuaError e => Pusher e Pandoc
+pushPandoc (Pandoc meta blocks) =
+  pushViaConstr' "Pandoc" [pushList pushBlock blocks, push meta]
+
+peekPandoc :: LuaError e => Peeker e Pandoc
+peekPandoc = fmap (retrieving "Pandoc value")
+  . typeChecked "table" Lua.istable $ \idx -> do
+      meta <- peekFieldRaw peekMeta "meta" idx
+      blks <- peekFieldRaw peekBlocks "blocks" idx
+      return $ Pandoc meta blks
 
 instance Pushable Meta where
   push (Meta mmap) =
-    pushViaConstructor "Meta" mmap
-instance Peekable Meta where
-  peek idx = defineHowTo "get Meta value" $!
-    Meta <$!> Lua.peek idx
+    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 Peekable MetaValue where
-  peek = peekMetaValue
 
 instance Pushable Block where
   push = pushBlock
 
-instance Peekable Block where
-  peek = peekBlock
-
 -- Inline
 instance Pushable Inline where
   push = pushInline
 
-instance Peekable Inline where
-  peek = peekInline
-
 -- Citation
 instance Pushable Citation where
   push (Citation cid prefix suffix mode noteNum hash) =
-    pushViaConstructor "Citation" cid mode prefix suffix noteNum hash
+    pushViaConstr' "Citation"
+    [ push cid, push mode, push prefix, push suffix, push noteNum, push hash
+    ]
+
+peekCitation :: LuaError e => Peeker e Citation
+peekCitation = fmap (retrieving "Citation")
+  . typeChecked "table" Lua.istable $ \idx -> do
+      idx' <- liftLua $ absindex idx
+      Citation
+        <$!> peekFieldRaw peekText "id" idx'
+        <*>  peekFieldRaw (peekList peekInline) "prefix" idx'
+        <*>  peekFieldRaw (peekList peekInline) "suffix" idx'
+        <*>  peekFieldRaw peekRead "mode" idx'
+        <*>  peekFieldRaw peekIntegral "note_num" idx'
+        <*>  peekFieldRaw peekIntegral "hash" idx'
 
-instance Peekable Citation where
-  peek idx = Citation
-    <$!> LuaUtil.rawField idx "id"
-    <*> LuaUtil.rawField idx "prefix"
-    <*> LuaUtil.rawField idx "suffix"
-    <*> LuaUtil.rawField idx "mode"
-    <*> LuaUtil.rawField idx "note_num"
-    <*> LuaUtil.rawField idx "hash"
 
 instance Pushable Alignment where
-  push = Lua.push . show
-instance Peekable Alignment where
-  peek = Lua.peekRead
+  push = Lua.pushString . show
 
 instance Pushable CitationMode where
   push = Lua.push . show
-instance Peekable CitationMode where
-  peek = Lua.peekRead
 
 instance Pushable Format where
   push (Format f) = Lua.push f
-instance Peekable Format where
-  peek idx = Format <$!> Lua.peek idx
+
+peekFormat :: LuaError e => Peeker e Format
+peekFormat idx = Format <$!> peekText idx
 
 instance Pushable ListNumberDelim where
   push = Lua.push . show
-instance Peekable ListNumberDelim where
-  peek = Lua.peekRead
 
 instance Pushable ListNumberStyle where
   push = Lua.push . show
-instance Peekable ListNumberStyle where
-  peek = Lua.peekRead
 
 instance Pushable MathType where
   push = Lua.push . show
-instance Peekable MathType where
-  peek = Lua.peekRead
 
 instance Pushable QuoteType where
   push = Lua.push . show
-instance Peekable QuoteType where
-  peek = Lua.peekRead
 
 -- | Push an meta value element to the top of the lua stack.
-pushMetaValue :: MetaValue -> Lua ()
+pushMetaValue :: LuaError e => MetaValue -> LuaE e ()
 pushMetaValue = \case
-  MetaBlocks blcks  -> pushViaConstructor "MetaBlocks" blcks
+  MetaBlocks blcks  -> pushViaConstr' "MetaBlocks" [pushList pushBlock blcks]
   MetaBool bool     -> Lua.push bool
-  MetaInlines inlns -> pushViaConstructor "MetaInlines" inlns
-  MetaList metalist -> pushViaConstructor "MetaList" metalist
-  MetaMap metamap   -> pushViaConstructor "MetaMap" metamap
+  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 :: StackIndex -> Lua MetaValue
-peekMetaValue idx = defineHowTo "get MetaValue" $ do
+peekMetaValue :: forall e. LuaError e => Peeker e MetaValue
+peekMetaValue = retrieving "MetaValue $ " . \idx -> do
   -- Get the contents of an AST element.
-  let elementContent :: Peekable a => Lua a
-      elementContent = Lua.peek idx
-  luatype <- Lua.ltype idx
-  case luatype of
-    Lua.TypeBoolean -> MetaBool <$!> Lua.peek idx
-    Lua.TypeString  -> MetaString <$!> Lua.peek idx
-    Lua.TypeTable   -> do
-      tag <- try $ LuaUtil.getTag idx
-      case tag of
-        Right "MetaBlocks"  -> MetaBlocks  <$!> elementContent
-        Right "MetaBool"    -> MetaBool    <$!> elementContent
-        Right "MetaMap"     -> MetaMap     <$!> elementContent
-        Right "MetaInlines" -> MetaInlines <$!> elementContent
-        Right "MetaList"    -> MetaList    <$!> elementContent
-        Right "MetaString"  -> MetaString  <$!> elementContent
-        Right t             -> Lua.throwMessage ("Unknown meta tag: " <> t)
-        Left _ -> do
+  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 <- Lua.rawlen idx
+        len <- liftLua $ Lua.rawlen idx
         if len <= 0
-            then MetaMap <$!> Lua.peek idx
-            else  (MetaInlines <$!> Lua.peek idx)
-                  <|> (MetaBlocks <$!> Lua.peek idx)
-                  <|> (MetaList <$!> Lua.peek idx)
-    _        -> Lua.throwMessage "could not get meta value"
+          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
+    _        -> failPeek "could not get meta value"
 
 -- | Push a block element to the top of the Lua stack.
-pushBlock :: Block -> Lua ()
+pushBlock :: forall e. LuaError e => Block -> LuaE e ()
 pushBlock = \case
-  BlockQuote blcks         -> pushViaConstructor "BlockQuote" blcks
-  BulletList items         -> pushViaConstructor "BulletList" items
-  CodeBlock attr code      -> pushViaConstructor "CodeBlock" code (LuaAttr attr)
-  DefinitionList items     -> pushViaConstructor "DefinitionList" items
-  Div attr blcks           -> pushViaConstructor "Div" blcks (LuaAttr attr)
-  Header lvl attr inlns    -> pushViaConstructor "Header" lvl inlns (LuaAttr attr)
-  HorizontalRule           -> pushViaConstructor "HorizontalRule"
-  LineBlock blcks          -> pushViaConstructor "LineBlock" blcks
-  OrderedList lstAttr list -> pushViaConstructor "OrderedList" list
-                                                 (LuaListAttributes lstAttr)
-  Null                     -> pushViaConstructor "Null"
-  Para blcks               -> pushViaConstructor "Para" blcks
-  Plain blcks              -> pushViaConstructor "Plain" blcks
-  RawBlock f cs            -> pushViaConstructor "RawBlock" f cs
+  BlockQuote blcks         -> pushViaConstructor @e "BlockQuote" blcks
+  BulletList items         -> pushViaConstructor @e "BulletList" items
+  CodeBlock attr code      -> pushViaConstr' @e "CodeBlock"
+                              [ push code, pushAttr attr ]
+  DefinitionList items     -> pushViaConstructor @e "DefinitionList" items
+  Div attr blcks           -> pushViaConstr' @e "Div"
+                              [push blcks, pushAttr attr]
+  Header lvl attr inlns    -> pushViaConstr' @e "Header"
+                              [push lvl, push inlns, pushAttr attr]
+  HorizontalRule           -> pushViaConstructor @e "HorizontalRule"
+  LineBlock blcks          -> pushViaConstructor @e "LineBlock" blcks
+  OrderedList lstAttr list -> pushViaConstr' @e "OrderedList"
+                              [ push list, pushListAttributes @e lstAttr ]
+  Null                     -> pushViaConstructor @e "Null"
+  Para blcks               -> pushViaConstructor @e "Para" blcks
+  Plain blcks              -> pushViaConstructor @e "Plain" blcks
+  RawBlock f cs            -> pushViaConstructor @e "RawBlock" f cs
   Table attr blkCapt specs thead tbody tfoot ->
-    pushViaConstructor "Table" blkCapt specs thead tbody tfoot attr
+    pushViaConstr' @e "Table"
+    [ pushCaption blkCapt, push specs, push thead, push tbody
+    , push tfoot, pushAttr attr]
 
 -- | Return the value at the given index as block if possible.
-peekBlock :: StackIndex -> Lua Block
-peekBlock idx = defineHowTo "get Block value" $! do
-  tag <- LuaUtil.getTag idx
-  case tag of
-      "BlockQuote"     -> BlockQuote <$!> elementContent
-      "BulletList"     -> BulletList <$!> elementContent
-      "CodeBlock"      -> withAttr CodeBlock <$!> elementContent
-      "DefinitionList" -> DefinitionList <$!> elementContent
-      "Div"            -> withAttr Div <$!> elementContent
-      "Header"         -> (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
-                          <$!> elementContent
-      "HorizontalRule" -> return HorizontalRule
-      "LineBlock"      -> LineBlock <$!> elementContent
-      "OrderedList"    -> (\(LuaListAttributes lstAttr, lst) ->
-                             OrderedList lstAttr lst)
-                          <$!> elementContent
-      "Null"           -> return Null
-      "Para"           -> Para <$!> elementContent
-      "Plain"          -> Plain <$!> elementContent
-      "RawBlock"       -> uncurry RawBlock <$!> elementContent
-      "Table"          -> (\(attr, capt, colSpecs, thead, tbodies, tfoot) ->
-                              Table (fromLuaAttr attr)
-                                    capt
-                                    colSpecs
-                                    thead
-                                    tbodies
-                                    tfoot)
-                          <$!> elementContent
-      _ -> Lua.throwMessage ("Unknown block type: " <> tag)
- where
+peekBlock :: forall e. LuaError e => Peeker e Block
+peekBlock = fmap (retrieving "Block")
+  . typeChecked "table" Lua.istable
+  $ \idx -> do
   -- Get the contents of an AST element.
-   elementContent :: Peekable a => Lua a
-   elementContent = LuaUtil.rawField idx "c"
+  let mkBlock :: (a -> Block) -> Peeker e a -> Peek e Block
+      mkBlock f p = f <$!> peekFieldRaw p "c" idx
+  LuaUtil.getTag idx >>= \case
+      "BlockQuote"     -> mkBlock BlockQuote peekBlocks
+      "BulletList"     -> mkBlock BulletList (peekList peekBlocks)
+      "CodeBlock"      -> mkBlock (uncurry CodeBlock)
+                                  (peekPair peekAttr peekText)
+      "DefinitionList" -> mkBlock DefinitionList
+                          (peekList (peekPair peekInlines (peekList peekBlocks)))
+      "Div"            -> mkBlock (uncurry Div) (peekPair peekAttr peekBlocks)
+      "Header"         -> mkBlock (\(lvl, attr, lst) -> Header lvl attr lst)
+                          (peekTriple peekIntegral peekAttr peekInlines)
+      "HorizontalRule" -> return HorizontalRule
+      "LineBlock"      -> mkBlock LineBlock (peekList peekInlines)
+      "OrderedList"    -> mkBlock (uncurry OrderedList)
+                          (peekPair peekListAttributes (peekList peekBlocks))
+      "Null"           -> return Null
+      "Para"           -> mkBlock Para peekInlines
+      "Plain"          -> mkBlock Plain peekInlines
+      "RawBlock"       -> mkBlock (uncurry RawBlock)
+                                  (peekPair peekFormat peekText)
+      "Table"          -> mkBlock id
+        (retrieving "Table" . (liftLua . absindex >=> (\idx' -> cleanup $ do
+          attr  <- liftLua (rawgeti idx' 1) *> peekAttr top
+          capt  <- liftLua (rawgeti idx' 2) *> peekCaption top
+          cs    <- liftLua (rawgeti idx' 3) *> peekList peekColSpec top
+          thead <- liftLua (rawgeti idx' 4) *> peekTableHead top
+          tbods <- liftLua (rawgeti idx' 5) *> peekList peekTableBody top
+          tfoot <- liftLua (rawgeti idx' 6) *> peekTableFoot top
+          return $! Table attr capt cs thead tbods tfoot)))
+      Name tag -> failPeek ("Unknown block type: " <> tag)
 
-instance Pushable Caption where
-  push = pushCaption
+peekBlocks :: LuaError e => Peeker e [Block]
+peekBlocks = peekList peekBlock
 
-instance Peekable Caption where
-  peek = peekCaption
+peekInlines :: LuaError e => Peeker e [Inline]
+peekInlines = peekList peekInline
 
 -- | Push Caption element
-pushCaption :: Caption -> Lua ()
+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 :: StackIndex -> Lua Caption
-peekCaption idx = Caption
-  <$!> (Lua.fromOptional <$!> LuaUtil.rawField idx "short")
-  <*>  LuaUtil.rawField idx "long"
+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
 
-instance Peekable ColWidth where
-  peek idx = do
-    width <- Lua.fromOptional <$!> Lua.peek idx
-    return $! maybe ColWidthDefault ColWidth width
+peekColWidth :: LuaError e => Peeker e ColWidth
+peekColWidth = retrieving "ColWidth" . \idx -> do
+  maybe ColWidthDefault ColWidth <$!> optional (peekRealFloat idx)
+
+peekColSpec :: LuaError e => Peeker e ColSpec
+peekColSpec = peekPair peekRead peekColWidth
 
 instance Pushable ColWidth where
   push = \case
@@ -240,7 +273,12 @@ instance Pushable Row where
   push (Row attr cells) = Lua.push (attr, cells)
 
 instance Peekable Row where
-  peek = fmap (uncurry Row) . Lua.peek
+  peek = forcePeek . peekRow
+
+peekRow :: LuaError e => Peeker e Row
+peekRow = ((uncurry Row) <$!>)
+  . retrieving "Row"
+  . peekPair peekAttr (peekList peekCell)
 
 instance Pushable TableBody where
   push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do
@@ -250,32 +288,38 @@ instance Pushable TableBody where
     LuaUtil.addField "head" head'
     LuaUtil.addField "body" body
 
-instance Peekable TableBody where
-  peek idx = TableBody
-    <$!> LuaUtil.rawField idx "attr"
-    <*>  (RowHeadColumns <$!> LuaUtil.rawField idx "row_head_columns")
-    <*>  LuaUtil.rawField idx "head"
-    <*>  LuaUtil.rawField idx "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
 
 instance Pushable TableHead where
   push (TableHead attr rows) = Lua.push (attr, rows)
 
-instance Peekable TableHead where
-  peek = fmap (uncurry TableHead) . Lua.peek
+peekTableHead :: LuaError e => Peeker e TableHead
+peekTableHead = ((uncurry TableHead) <$!>)
+  . retrieving "TableHead"
+  . peekPair peekAttr (peekList peekRow)
 
 instance Pushable TableFoot where
   push (TableFoot attr cells) = Lua.push (attr, cells)
 
-instance Peekable TableFoot where
-  peek = fmap (uncurry TableFoot) . Lua.peek
+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 = peekCell
+  peek = forcePeek . peekCell
 
-pushCell :: Cell -> Lua ()
+pushCell :: LuaError e => Cell -> LuaE e ()
 pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do
   Lua.newtable
   LuaUtil.addField "attr" attr
@@ -284,95 +328,112 @@ pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do
   LuaUtil.addField "col_span" colSpan
   LuaUtil.addField "contents" contents
 
-peekCell :: StackIndex -> Lua Cell
-peekCell idx = Cell
-  <$!> (fromLuaAttr <$!> LuaUtil.rawField idx "attr")
-  <*>  LuaUtil.rawField idx "alignment"
-  <*>  (RowSpan <$!> LuaUtil.rawField idx "row_span")
-  <*>  (ColSpan <$!> LuaUtil.rawField idx "col_span")
-  <*>  LuaUtil.rawField idx "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
 
 -- | Push an inline element to the top of the lua stack.
-pushInline :: Inline -> Lua ()
+pushInline :: forall e. LuaError e => Inline -> LuaE e ()
 pushInline = \case
-  Cite citations lst       -> pushViaConstructor "Cite" lst citations
-  Code attr lst            -> pushViaConstructor "Code" lst (LuaAttr attr)
-  Emph inlns               -> pushViaConstructor "Emph" inlns
-  Underline inlns          -> pushViaConstructor "Underline" inlns
-  Image attr alt (src,tit) -> pushViaConstructor "Image" alt src tit (LuaAttr attr)
-  LineBreak                -> pushViaConstructor "LineBreak"
-  Link attr lst (src,tit)  -> pushViaConstructor "Link" lst src tit (LuaAttr attr)
-  Note blcks               -> pushViaConstructor "Note" blcks
-  Math mty str             -> pushViaConstructor "Math" mty str
-  Quoted qt inlns          -> pushViaConstructor "Quoted" qt inlns
-  RawInline f cs           -> pushViaConstructor "RawInline" f cs
-  SmallCaps inlns          -> pushViaConstructor "SmallCaps" inlns
-  SoftBreak                -> pushViaConstructor "SoftBreak"
-  Space                    -> pushViaConstructor "Space"
-  Span attr inlns          -> pushViaConstructor "Span" inlns (LuaAttr attr)
-  Str str                  -> pushViaConstructor "Str" str
-  Strikeout inlns          -> pushViaConstructor "Strikeout" inlns
-  Strong inlns             -> pushViaConstructor "Strong" inlns
-  Subscript inlns          -> pushViaConstructor "Subscript" inlns
-  Superscript inlns        -> pushViaConstructor "Superscript" inlns
+  Cite citations lst       -> pushViaConstructor @e "Cite" lst citations
+  Code attr lst            -> pushViaConstr' @e "Code"
+                              [push lst, pushAttr attr]
+  Emph inlns               -> pushViaConstructor @e "Emph" inlns
+  Underline inlns          -> pushViaConstructor @e "Underline" inlns
+  Image attr alt (src,tit) -> pushViaConstr' @e "Image"
+                              [push alt, push src, push tit, pushAttr attr]
+  LineBreak                -> pushViaConstructor @e "LineBreak"
+  Link attr lst (src,tit)  -> pushViaConstr' @e "Link"
+                              [push lst, push src, push tit, pushAttr attr]
+  Note blcks               -> pushViaConstructor @e "Note" blcks
+  Math mty str             -> pushViaConstructor @e "Math" mty str
+  Quoted qt inlns          -> pushViaConstructor @e "Quoted" qt inlns
+  RawInline f cs           -> pushViaConstructor @e "RawInline" f cs
+  SmallCaps inlns          -> pushViaConstructor @e "SmallCaps" inlns
+  SoftBreak                -> pushViaConstructor @e "SoftBreak"
+  Space                    -> pushViaConstructor @e "Space"
+  Span attr inlns          -> pushViaConstr' @e "Span"
+                              [push inlns, pushAttr attr]
+  Str str                  -> pushViaConstructor @e "Str" str
+  Strikeout inlns          -> pushViaConstructor @e "Strikeout" inlns
+  Strong inlns             -> pushViaConstructor @e "Strong" inlns
+  Subscript inlns          -> pushViaConstructor @e "Subscript" inlns
+  Superscript inlns        -> pushViaConstructor @e "Superscript" inlns
 
 -- | Return the value at the given index as inline if possible.
-peekInline :: StackIndex -> Lua Inline
-peekInline idx = defineHowTo "get Inline value" $ do
-  tag <- LuaUtil.getTag idx
-  case tag of
-    "Cite"       -> uncurry Cite <$!> elementContent
-    "Code"       -> withAttr Code <$!> elementContent
-    "Emph"       -> Emph <$!> elementContent
-    "Underline"  -> Underline <$!> elementContent
-    "Image"      -> (\(LuaAttr !attr, !lst, !tgt) -> Image attr lst tgt)
-                    <$!> elementContent
-    "Link"       -> (\(LuaAttr !attr, !lst, !tgt) -> Link attr lst tgt)
-                    <$!> elementContent
+peekInline :: forall e. LuaError e => Peeker e Inline
+peekInline = retrieving "Inline" . \idx -> do
+  -- Get the contents of an AST element.
+  let mkBlock :: (a -> Inline) -> Peeker e a -> Peek e Inline
+      mkBlock f p = f <$!> peekFieldRaw p "c" idx
+  LuaUtil.getTag idx >>= \case
+    "Cite"       -> mkBlock (uncurry Cite) $
+                    peekPair (peekList peekCitation) peekInlines
+    "Code"       -> mkBlock (uncurry Code) (peekPair peekAttr peekText)
+    "Emph"       -> mkBlock Emph peekInlines
+    "Underline"  -> mkBlock Underline peekInlines
+    "Image"      -> mkBlock (\(attr, lst, tgt) -> Image attr lst tgt)
+                    $ peekTriple peekAttr peekInlines
+                                 (peekPair peekText peekText)
+    "Link"       -> mkBlock (\(attr, lst, tgt) -> Link attr lst tgt) $
+                    peekTriple peekAttr peekInlines (peekPair peekText peekText)
     "LineBreak"  -> return LineBreak
-    "Note"       -> Note <$!> elementContent
-    "Math"       -> uncurry Math <$!> elementContent
-    "Quoted"     -> uncurry Quoted <$!> elementContent
-    "RawInline"  -> uncurry RawInline <$!> elementContent
-    "SmallCaps"  -> SmallCaps <$!> elementContent
+    "Note"       -> mkBlock Note peekBlocks
+    "Math"       -> mkBlock (uncurry Math) (peekPair peekRead peekText)
+    "Quoted"     -> mkBlock (uncurry Quoted) (peekPair peekRead peekInlines)
+    "RawInline"  -> mkBlock (uncurry RawInline) (peekPair peekFormat peekText)
+    "SmallCaps"  -> mkBlock SmallCaps peekInlines
     "SoftBreak"  -> return SoftBreak
     "Space"      -> return Space
-    "Span"       -> withAttr Span <$!> elementContent
-    -- strict to Lua string is copied before gc
-    "Str"        -> Str <$!> elementContent
-    "Strikeout"  -> Strikeout <$!> elementContent
-    "Strong"     -> Strong <$!> elementContent
-    "Subscript"  -> Subscript <$!> elementContent
-    "Superscript"-> Superscript <$!> elementContent
-    _ -> Lua.throwMessage ("Unknown inline type: " <> tag)
- where
-   -- Get the contents of an AST element.
-   elementContent :: Peekable a => Lua a
-   elementContent = LuaUtil.rawField idx "c"
+    "Span"       -> mkBlock (uncurry Span) (peekPair peekAttr peekInlines)
+    "Str"        -> mkBlock Str peekText
+    "Strikeout"  -> mkBlock Strikeout peekInlines
+    "Strong"     -> mkBlock Strong peekInlines
+    "Subscript"  -> mkBlock Subscript peekInlines
+    "Superscript"-> mkBlock Superscript peekInlines
+    Name tag -> Lua.failPeek ("Unknown inline type: " <> tag)
 
-try :: Lua a -> Lua (Either PandocError a)
-try = Catch.try
+pushAttr :: forall e. LuaError e => Attr -> LuaE e ()
+pushAttr (id', classes, kv) = pushViaConstr' @e "Attr"
+  [ pushText id'
+  , pushList pushText classes
+  , pushList (pushPair pushText pushText) kv
+  ]
 
-withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
-withAttr f (attributes, x) = f (fromLuaAttr attributes) x
+peekAttr :: LuaError e => Peeker e Attr
+peekAttr = retrieving "Attr" . peekTriple
+  peekText
+  (peekList peekText)
+  (peekList (peekPair peekText peekText))
 
--- | Wrapper for Attr
-newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
+pushListAttributes :: forall e. LuaError e => ListAttributes -> LuaE e ()
+pushListAttributes (start, style, delimiter) =
+    pushViaConstr' "ListAttributes"
+    [ push start, push style, push delimiter ]
 
-instance Pushable LuaAttr where
-  push (LuaAttr (id', classes, kv)) =
-    pushViaConstructor "Attr" id' classes kv
+peekListAttributes :: LuaError e => Peeker e ListAttributes
+peekListAttributes = retrieving "ListAttributes" . peekTriple
+  peekIntegral
+  peekRead
+  peekRead
 
-instance Peekable LuaAttr where
-  peek idx = defineHowTo "get Attr value" $! (LuaAttr <$!> Lua.peek idx)
+-- These instances exist only for testing. It's a hack to avoid making
+-- the marshalling modules public.
+instance Peekable Inline where
+  peek = forcePeek . peekInline
 
--- | Wrapper for ListAttributes
-newtype LuaListAttributes = LuaListAttributes  ListAttributes
+instance Peekable Block where
+  peek = forcePeek . peekBlock
 
-instance Pushable LuaListAttributes where
-  push (LuaListAttributes (start, style, delimiter)) =
-    pushViaConstructor "ListAttributes" start style delimiter
+instance Peekable Meta where
+  peek = forcePeek . peekMeta
 
-instance Peekable LuaListAttributes where
-  peek = defineHowTo "get ListAttributes value" .
-         fmap LuaListAttributes . Lua.peek
+instance Peekable Pandoc where
+  peek = forcePeek . peekPandoc

src/Text/Pandoc/Lua/Marshaling/AnyValue.hs

@@ -1,24 +0,0 @@
-{- |
-   Module      : Text.Pandoc.Lua.Marshaling.AnyValue
-   Copyright   : © 2017-2021 Albert Krewinkel
-   License     : GNU GPL, version 2 or above
-
-   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
-   Stability   : alpha
-
-Helper type to work with raw Lua stack indices instead of unmarshaled
-values.
-
-TODO: Most of this module should be abstracted, factored out, and go
-into HsLua.
--}
-module Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..)) where
-
-import Foreign.Lua (Peekable (peek), StackIndex)
-
--- | Dummy type to allow values of arbitrary Lua type. This just wraps
--- stack indices, using it requires extra care.
-newtype AnyValue = AnyValue StackIndex
-
-instance Peekable AnyValue where
-  peek = return . AnyValue

src/Text/Pandoc/Lua/Marshaling/CommonState.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshaling.CommonState
@@ -11,92 +9,62 @@
 
 Instances to marshal (push) and unmarshal (peek) the common state.
 -}
-module Text.Pandoc.Lua.Marshaling.CommonState () where
+module Text.Pandoc.Lua.Marshaling.CommonState
+  ( typeCommonState
+  , peekCommonState
+  , pushCommonState
+  ) where
 
-import Foreign.Lua (Lua, Peekable, Pushable)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
-                             toAnyWithName)
+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.AnyValue (AnyValue (..))
+import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
 
-import qualified Data.Map as Map
-import qualified Data.Text as Text
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
+-- | 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)
 
--- | Name used by Lua for the @CommonState@ type.
-commonStateTypeName :: String
-commonStateTypeName = "Pandoc CommonState"
+  , readonly "output_file" "the file to which pandoc will write"
+      (maybe pushnil pushString, stOutputFile)
 
-instance Peekable CommonState where
-  peek idx = reportValueOnFailure commonStateTypeName
-             (`toAnyWithName` commonStateTypeName) idx
+  , readonly "log" "list of log messages"
+      (pushPandocList (pushUD typeLogMessage), stLog)
 
-instance Pushable CommonState where
-  push st = pushAnyWithMetatable pushCommonStateMetatable st
-   where
-    pushCommonStateMetatable = ensureUserdataMetatable commonStateTypeName $ do
-      LuaUtil.addFunction "__index" indexCommonState
-      LuaUtil.addFunction "__pairs" pairsCommonState
+  , readonly "request_headers" "headers to add for HTTP requests"
+      (pushPandocList (pushPair pushText pushText), stRequestHeaders)
 
-indexCommonState :: CommonState -> AnyValue -> Lua Lua.NumResults
-indexCommonState st (AnyValue idx) = Lua.ltype idx >>= \case
-  Lua.TypeString -> 1 <$ (Lua.peek idx >>= pushField)
-  _ -> 1 <$ Lua.pushnil
- where
-  pushField :: Text.Text -> Lua ()
-  pushField name = case lookup name commonStateFields of
-    Just pushValue -> pushValue st
-    Nothing -> Lua.pushnil
+  , readonly "resource_path"
+      "path to search for resources like included images"
+      (pushPandocList pushString, stResourcePath)
 
-pairsCommonState :: CommonState -> Lua Lua.NumResults
-pairsCommonState st = do
-  Lua.pushHaskellFunction nextFn
-  Lua.pushnil
-  Lua.pushnil
-  return 3
- where
-  nextFn :: AnyValue -> AnyValue -> Lua Lua.NumResults
-  nextFn _ (AnyValue idx) =
-    Lua.ltype idx >>= \case
-      Lua.TypeNil -> case commonStateFields of
-        []  -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-        (key, pushValue):_ -> 2 <$ (Lua.push key *> pushValue st)
-      Lua.TypeString -> do
-        key <- Lua.peek idx
-        case tail $ dropWhile ((/= key) . fst) commonStateFields of
-          []                     -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-          (nextKey, pushValue):_ -> 2 <$ (Lua.push nextKey *> pushValue st)
-      _ -> 2 <$ (Lua.pushnil *> Lua.pushnil)
+  , readonly "source_url" "absolute URL + dir of 1st source file"
+      (maybe pushnil pushText, stSourceURL)
 
-commonStateFields :: [(Text.Text, CommonState -> Lua ())]
-commonStateFields =
-  [ ("input_files", Lua.push . stInputFiles)
-  , ("output_file", Lua.push . Lua.Optional . stOutputFile)
-  , ("log", Lua.push . stLog)
-  , ("request_headers", Lua.push . Map.fromList . stRequestHeaders)
-  , ("resource_path", Lua.push . stResourcePath)
-  , ("source_url", Lua.push . Lua.Optional . stSourceURL)
-  , ("user_data_dir", Lua.push . Lua.Optional . stUserDataDir)
-  , ("trace", Lua.push . stTrace)
-  , ("verbosity", Lua.push . show . stVerbosity)
+  , 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)
   ]
 
--- | Name used by Lua for the @CommonState@ type.
-logMessageTypeName :: String
-logMessageTypeName = "Pandoc LogMessage"
+peekCommonState :: LuaError e => Peeker e CommonState
+peekCommonState = peekUD typeCommonState
 
-instance Peekable LogMessage where
-  peek idx = reportValueOnFailure logMessageTypeName
-             (`toAnyWithName` logMessageTypeName) idx
+pushCommonState :: LuaError e => Pusher e CommonState
+pushCommonState = pushUD typeCommonState
 
-instance Pushable LogMessage where
-  push msg = pushAnyWithMetatable pushLogMessageMetatable msg
-   where
-    pushLogMessageMetatable = ensureUserdataMetatable logMessageTypeName $
-      LuaUtil.addFunction "__tostring" tostringLogMessage
-
-tostringLogMessage :: LogMessage -> Lua Text.Text
-tostringLogMessage = return . showLogMessage
+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

src/Text/Pandoc/Lua/Marshaling/Context.hs

@@ -12,8 +12,8 @@ Marshaling instance for doctemplates Context and its components.
 -}
 module Text.Pandoc.Lua.Marshaling.Context () where
 
-import qualified Foreign.Lua as Lua
-import Foreign.Lua (Pushable)
+import qualified HsLua as Lua
+import HsLua (Pushable)
 import Text.DocTemplates (Context(..), Val(..), TemplateTarget)
 import Text.DocLayout (render)
 

src/Text/Pandoc/Lua/Marshaling/List.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable    #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {- |
 Module      : Text.Pandoc.Lua.Marshaling.List
@@ -14,27 +15,30 @@ 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 Foreign.Lua (Peekable, Pushable)
+import HsLua (LuaError, Peeker, Pusher, Pushable (push), peekList, pushList)
 import Text.Pandoc.Walk (Walkable (..))
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
-
-import qualified Foreign.Lua as Lua
+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) =
-    pushViaConstructor "List" xs
+  push (List xs) = pushPandocList push xs
 
-instance Peekable a => Peekable (List a) where
-  peek idx = defineHowTo "get List" $ do
-    xs <- Lua.peek idx
-    return $ List 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.

src/Text/Pandoc/Lua/Marshaling/MediaBag.hs

@@ -1,73 +0,0 @@
-{- |
-   Module      : Text.Pandoc.Lua.Marshaling.MediaBag
-   Copyright   : © 2012-2021 John MacFarlane
-                 © 2017-2021 Albert Krewinkel
-   License     : GNU GPL, version 2 or above
-   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
-   Stability   : alpha
-
-Instances to marshal (push) and unmarshal (peek) media data.
--}
-module Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator) where
-
-import Foreign.Ptr (Ptr)
-import Foreign.StablePtr (StablePtr, deRefStablePtr, newStablePtr)
-import Foreign.Lua (Lua, NumResults, Peekable, Pushable, StackIndex)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
-                             toAnyWithName)
-import Text.Pandoc.MediaBag (MediaBag, mediaItems)
-import Text.Pandoc.MIME (MimeType)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-
-import qualified Data.ByteString.Lazy as BL
-import qualified Foreign.Lua as Lua
-import qualified Foreign.Storable as Storable
-
--- | A list of 'MediaBag' items.
-newtype MediaItems = MediaItems [(String, MimeType, BL.ByteString)]
-
-instance Pushable MediaItems where
-  push = pushMediaItems
-
-instance Peekable MediaItems where
-  peek = peekMediaItems
-
--- | Push an iterator triple to be used with Lua's @for@ loop construct.
--- Each iterator invocation returns a triple containing the item's
--- filename, MIME type, and content.
-pushIterator :: MediaBag -> Lua NumResults
-pushIterator mb = do
-  Lua.pushHaskellFunction nextItem
-  Lua.push (MediaItems $ mediaItems mb)
-  Lua.pushnil
-  return 3
-
--- | Lua type name for @'MediaItems'@.
-mediaItemsTypeName :: String
-mediaItemsTypeName = "pandoc MediaItems"
-
--- | Push a @MediaItems@ element to the stack.
-pushMediaItems :: MediaItems -> Lua ()
-pushMediaItems xs = pushAnyWithMetatable pushMT xs
- where
-  pushMT = ensureUserdataMetatable mediaItemsTypeName (return ())
-
--- | Retrieve a @MediaItems@ element from the stack.
-peekMediaItems :: StackIndex -> Lua MediaItems
-peekMediaItems = reportValueOnFailure mediaItemsTypeName
-                 (`toAnyWithName` mediaItemsTypeName)
-
--- | Retrieve a list of items from an iterator state, return the first
--- item (if present), and advance the state.
-nextItem :: Ptr (StablePtr MediaItems) -> AnyValue -> Lua NumResults
-nextItem ptr _ = do
-  (MediaItems items) <- Lua.liftIO $ deRefStablePtr =<< Storable.peek ptr
-  case items of
-    [] -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-    (key, mt, content):xs -> do
-      Lua.liftIO $ Storable.poke ptr =<< newStablePtr (MediaItems xs)
-      Lua.push key
-      Lua.push mt
-      Lua.push content
-      return 3

src/Text/Pandoc/Lua/Marshaling/PandocError.hs

@@ -1,7 +1,7 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshaling.PandocError
    Copyright   : © 2020-2021 Albert Krewinkel
@@ -15,51 +15,37 @@ Marshaling of @'PandocError'@ values.
 module Text.Pandoc.Lua.Marshaling.PandocError
   ( peekPandocError
   , pushPandocError
+  , typePandocError
   )
   where
 
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import HsLua.Core (LuaError)
+import HsLua.Marshalling (Peeker, Pusher, pushString, liftLua)
+import HsLua.Packaging
 import Text.Pandoc.Error (PandocError (PandocLuaError))
 
-import qualified Foreign.Lua as Lua
-import qualified Foreign.Lua.Userdata as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
+import qualified HsLua as Lua
 import qualified Text.Pandoc.UTF8 as UTF8
 
--- | Userdata name used by Lua for the @PandocError@ type.
-pandocErrorName :: String
-pandocErrorName = "pandoc error"
+-- | 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 :: PandocError -> Lua ()
-pushPandocError = Lua.pushAnyWithMetatable pushPandocErrorMT
-  where
-    pushPandocErrorMT = Lua.ensureUserdataMetatable pandocErrorName $
-      LuaUtil.addFunction "__tostring" __tostring
+pushPandocError :: LuaError e => Pusher e PandocError
+pushPandocError = pushUD typePandocError
 
 -- | Retrieve a @'PandocError'@ from the Lua stack.
-peekPandocError :: StackIndex -> Lua PandocError
-peekPandocError idx = Lua.ltype idx >>= \case
-  Lua.TypeUserdata -> do
-    errMb <- Lua.toAnyWithName idx pandocErrorName
-    return $ case errMb of
-      Just err -> err
-      Nothing  -> PandocLuaError "could not retrieve original error"
+peekPandocError :: LuaError e => Peeker e PandocError
+peekPandocError idx = Lua.retrieving "PandocError" $
+  liftLua (Lua.ltype idx) >>= \case
+    Lua.TypeUserdata -> peekUD typePandocError idx
     _ -> do
-    Lua.pushvalue idx
-    msg <- Lua.state >>= \l -> Lua.liftIO (Lua.errorMessage l)
+      msg <- liftLua $ Lua.state >>= \l -> Lua.liftIO (Lua.popErrorMessage l)
       return $ PandocLuaError (UTF8.toText msg)
-
--- | Convert to string.
-__tostring :: PandocError -> Lua String
-__tostring = return . show
-
---
--- Instances
---
-
-instance Pushable PandocError where
-  push = pushPandocError
-
-instance Peekable PandocError where
-  peek = peekPandocError

src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -13,67 +12,60 @@
 
 Marshaling instance for ReaderOptions and its components.
 -}
-module Text.Pandoc.Lua.Marshaling.ReaderOptions () where
+module Text.Pandoc.Lua.Marshaling.ReaderOptions
+  ( peekReaderOptions
+  , pushReaderOptions
+  ) where
 
-import Data.Data (showConstr, toConstr)
-import Foreign.Lua (Lua, Pushable)
-import Text.Pandoc.Extensions (Extensions)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
-import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
-
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
+import HsLua as Lua
+import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
+import Text.Pandoc.Options (ReaderOptions (..))
 
 --
 -- Reader Options
 --
-instance Pushable Extensions where
-  push exts = Lua.push (show exts)
 
-instance Pushable TrackChanges where
-  push = Lua.push . showConstr . toConstr
+peekReaderOptions :: LuaError e => Peeker e ReaderOptions
+peekReaderOptions = peekUD typeReaderOptions
 
-instance Pushable ReaderOptions where
-  push ro = do
-    let ReaderOptions
-          (extensions            :: Extensions)
-          (standalone            :: Bool)
-          (columns               :: Int)
-          (tabStop               :: Int)
-          (indentedCodeClasses   :: [Text.Text])
-          (abbreviations         :: Set.Set Text.Text)
-          (defaultImageExtension :: Text.Text)
-          (trackChanges          :: TrackChanges)
-          (stripComments         :: Bool)
-          = ro
-    Lua.newtable
-    LuaUtil.addField "extensions" extensions
-    LuaUtil.addField "standalone" standalone
-    LuaUtil.addField "columns" columns
-    LuaUtil.addField "tab_stop" tabStop
-    LuaUtil.addField "indented_code_classes" indentedCodeClasses
-    LuaUtil.addField "abbreviations" abbreviations
-    LuaUtil.addField "default_image_extension" defaultImageExtension
-    LuaUtil.addField "track_changes" trackChanges
-    LuaUtil.addField "strip_comments" stripComments
+pushReaderOptions :: LuaError e => Pusher e ReaderOptions
+pushReaderOptions = pushUD typeReaderOptions
 
-    -- add metatable
-    let indexReaderOptions :: AnyValue -> AnyValue -> Lua Lua.NumResults
-        indexReaderOptions _tbl (AnyValue key) = do
-          Lua.ltype key >>= \case
-            Lua.TypeString -> Lua.peek key >>= \case
-              ("defaultImageExtension" :: Text.Text)
-                                    -> Lua.push defaultImageExtension
-              "indentedCodeClasses" -> Lua.push indentedCodeClasses
-              "stripComments" -> Lua.push stripComments
-              "tabStop" -> Lua.push tabStop
-              "trackChanges" -> Lua.push trackChanges
-              _ -> Lua.pushnil
-            _ -> Lua.pushnil
-          return 1
-    Lua.newtable
-    LuaUtil.addFunction "__index" indexReaderOptions
-    Lua.setmetatable (Lua.nthFromTop 2)
+typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions
+typeReaderOptions = deftype "pandoc ReaderOptions"
+  [ operation Tostring luaShow
+  ]
+  [ readonly "extensions" ""
+      ( pushString . show
+      , readerExtensions)
+  , readonly "standalone" ""
+      ( pushBool
+      , readerStandalone)
+  , readonly "columns" ""
+      ( pushIntegral
+      , readerColumns)
+  , readonly "tab_stop" ""
+      ( pushIntegral
+      , readerTabStop)
+  , readonly "indented_code_classes" ""
+      ( pushPandocList pushText
+      , readerIndentedCodeClasses)
+  , readonly "abbreviations" ""
+      ( pushSet pushText
+      , readerAbbreviations)
+  , readonly "track_changes" ""
+      ( pushString . show
+      , readerTrackChanges)
+  , readonly "strip_comments" ""
+      ( pushBool
+      , readerStripComments)
+  , readonly "default_image_extension" ""
+      ( pushText
+      , readerDefaultImageExtension)
+  ]
+
+luaShow :: LuaError e => DocumentedFunction e
+luaShow = defun "__tostring"
+  ### liftPure show
+  <#> udparam typeReaderOptions "state" "object to print in native format"
+  =#> functionResult pushString "string" "Haskell representation"

src/Text/Pandoc/Lua/Marshaling/SimpleTable.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshaling.SimpleTable
    Copyright   : © 2020-2021 Albert Krewinkel
@@ -16,12 +19,11 @@ module Text.Pandoc.Lua.Marshaling.SimpleTable
   )
   where
 
-import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import Control.Monad ((<$!>))
+import HsLua as Lua
 import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor, rawField)
-import Text.Pandoc.Lua.Marshaling.AST ()
-
-import qualified Foreign.Lua as Lua
+import Text.Pandoc.Lua.Util (pushViaConstructor)
+import Text.Pandoc.Lua.Marshaling.AST
 
 -- | A simple (legacy-style) table.
 data SimpleTable = SimpleTable
@@ -32,16 +34,10 @@ data SimpleTable = SimpleTable
   , simpleTableBody :: [[[Block]]]
   }
 
-instance Pushable SimpleTable where
-  push = pushSimpleTable
-
-instance Peekable SimpleTable where
-  peek = peekSimpleTable
-
 -- | Push a simple table to the stack by calling the
 -- @pandoc.SimpleTable@ constructor.
-pushSimpleTable :: SimpleTable -> Lua ()
-pushSimpleTable tbl = pushViaConstructor "SimpleTable"
+pushSimpleTable :: forall e. LuaError e => SimpleTable -> LuaE e ()
+pushSimpleTable tbl = pushViaConstructor @e "SimpleTable"
   (simpleTableCaption tbl)
   (simpleTableAlignments tbl)
   (simpleTableColumnWidths tbl)
@@ -49,11 +45,10 @@ pushSimpleTable tbl = pushViaConstructor "SimpleTable"
   (simpleTableBody tbl)
 
 -- | Retrieve a simple table from the stack.
-peekSimpleTable :: StackIndex -> Lua SimpleTable
-peekSimpleTable idx = defineHowTo "get SimpleTable" $
-  SimpleTable
-    <$> rawField idx "caption"
-    <*> rawField idx "aligns"
-    <*> rawField idx "widths"
-    <*> rawField idx "headers"
-    <*> rawField idx "rows"
+peekSimpleTable :: forall e. LuaError e => Peeker e SimpleTable
+peekSimpleTable idx = retrieving "SimpleTable" $ SimpleTable
+  <$!> peekFieldRaw peekInlines "caption" idx
+  <*>  peekFieldRaw (peekList peekRead) "aligns" idx
+  <*>  peekFieldRaw (peekList peekRealFloat) "widths" idx
+  <*>  peekFieldRaw (peekList peekBlocks) "headers" idx
+  <*>  peekFieldRaw (peekList (peekList peekBlocks)) "rows" idx

src/Text/Pandoc/Lua/Marshaling/Version.hs

@@ -16,133 +16,92 @@ default comparison operators (like @>@ and @<=@).
 module Text.Pandoc.Lua.Marshaling.Version
   ( peekVersion
   , pushVersion
+  , peekVersionFuzzy
   )
   where
 
-import Data.Text (Text)
 import Data.Maybe (fromMaybe)
 import Data.Version (Version (..), makeVersion, parseVersion, showVersion)
-import Foreign.Lua (Lua, Optional (..), NumResults,
-                    Peekable, Pushable, StackIndex)
-import Foreign.Lua.Types.Peekable (reportValueOnFailure)
-import Foreign.Lua.Userdata (ensureUserdataMetatable, pushAnyWithMetatable,
-                             toAnyWithName)
-import Safe (atMay, lastMay)
-import Text.Pandoc.Lua.Marshaling.AnyValue (AnyValue (..))
+import HsLua as Lua
+import Safe (lastMay)
 import Text.ParserCombinators.ReadP (readP_to_S)
+import qualified Text.Pandoc.UTF8 as UTF8
 
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.Lua.Util as LuaUtil
-
--- | Push a @'Version'@ element to the Lua stack.
-pushVersion :: Version -> Lua ()
-pushVersion version = pushAnyWithMetatable pushVersionMT version
- where
-  pushVersionMT = ensureUserdataMetatable versionTypeName $ do
-    LuaUtil.addFunction "__eq" __eq
-    LuaUtil.addFunction "__le" __le
-    LuaUtil.addFunction "__lt" __lt
-    LuaUtil.addFunction "__len" __len
-    LuaUtil.addFunction "__index" __index
-    LuaUtil.addFunction "__pairs" __pairs
-    LuaUtil.addFunction "__tostring" __tostring
+instance Peekable Version where
+  peek = forcePeek . peekVersionFuzzy
 
 instance Pushable Version where
   push = pushVersion
 
-peekVersion :: StackIndex -> Lua Version
-peekVersion idx = Lua.ltype idx >>= \case
+-- | 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 <- Lua.peek idx
+    versionStr <- peekString idx
     let parses = readP_to_S parseVersion versionStr
     case lastMay parses of
       Just (v, "") -> return v
-      _  -> Lua.throwMessage $ "could not parse as Version: " ++ versionStr
+      _  -> Lua.failPeek $
+            UTF8.fromString $ "could not parse as Version: " ++ versionStr
 
-  Lua.TypeUserdata ->
-    reportValueOnFailure versionTypeName
-                         (`toAnyWithName` versionTypeName)
-                         idx
   Lua.TypeNumber -> do
-    n <- Lua.peek idx
-    return (makeVersion [n])
+    (makeVersion . (:[])) <$> peekIntegral idx
 
   Lua.TypeTable ->
-    makeVersion <$> Lua.peek idx
+    makeVersion <$> peekList peekIntegral idx
 
   _ ->
-    Lua.throwMessage "could not peek Version"
+    Lua.failPeek "could not peek Version"
 
-instance Peekable Version where
-  peek = peekVersion
+peekVersion :: LuaError e => Peeker e Version
+peekVersion = peekUD typeVersion
 
--- | Name used by Lua for the @CommonState@ type.
-versionTypeName :: String
-versionTypeName = "HsLua Version"
-
-__eq :: Version -> Version -> Lua Bool
-__eq v1 v2 = return (v1 == v2)
-
-__le :: Version -> Version -> Lua Bool
-__le v1 v2 = return (v1 <= v2)
-
-__lt :: Version -> Version -> Lua Bool
-__lt v1 v2 = return (v1 < v2)
-
--- | Get number of version components.
-__len :: Version -> Lua Int
-__len = return . length . versionBranch
-
--- | Access fields.
-__index :: Version -> AnyValue -> Lua NumResults
-__index v (AnyValue k) = do
-  ty <- Lua.ltype k
-  case ty of
-    Lua.TypeNumber -> do
-      n <- Lua.peek k
-      let versionPart = atMay (versionBranch v) (n - 1)
-      Lua.push (Lua.Optional versionPart)
-      return 1
-    Lua.TypeString -> do
-      (str :: Text) <- Lua.peek k
-      if str == "must_be_at_least"
-        then 1 <$ Lua.pushHaskellFunction must_be_at_least
-        else 1 <$ Lua.pushnil
-    _ -> 1 <$ Lua.pushnil
-
--- | Create iterator.
-__pairs :: Version -> Lua NumResults
-__pairs v = do
-  Lua.pushHaskellFunction nextFn
-  Lua.pushnil
-  Lua.pushnil
-  return 3
- where
-  nextFn :: AnyValue -> Optional Int -> Lua Lua.NumResults
-  nextFn _ (Optional key) =
-    case key of
-      Nothing -> case versionBranch v of
-                   []  -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-                   n:_ -> 2 <$ (Lua.push (1 :: Int) *> Lua.push n)
-      Just n  -> case atMay (versionBranch v) n of
-                   Nothing -> 2 <$ (Lua.pushnil *> Lua.pushnil)
-                   Just b  -> 2 <$ (Lua.push (n + 1) *> Lua.push b)
-
--- | Convert to string.
-__tostring :: Version -> Lua String
-__tostring v = return (showVersion v)
-
--- | 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"
+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 :: Version -> Version -> Optional String -> Lua NumResults
-must_be_at_least actual expected optMsg = do
-  let msg = fromMaybe versionTooOldMessage (fromOptional optMsg)
+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
@@ -152,3 +111,8 @@ must_be_at_least actual expected optMsg = do
       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"

src/Text/Pandoc/Lua/Module/MediaBag.hs

@@ -15,18 +15,19 @@ module Text.Pandoc.Lua.Module.MediaBag
 
 import Prelude hiding (lookup)
 import Control.Monad (zipWithM_)
-import Foreign.Lua (Lua, NumResults, Optional)
+import HsLua (LuaE, NumResults, Optional)
+import HsLua.Marshalling (pushIterator)
 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.MediaBag (pushIterator)
 import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction)
 import Text.Pandoc.MIME (MimeType)
 
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
-import qualified Foreign.Lua as Lua
+import qualified HsLua as Lua
 import qualified Text.Pandoc.MediaBag as MB
 
 --
@@ -65,7 +66,15 @@ insert fp optionalMime contents = do
 
 -- | Returns iterator values to be used with a Lua @for@ loop.
 items :: PandocLua NumResults
-items = getMediaBag >>= liftPandocLua . pushIterator
+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)
 
 lookup :: FilePath
        -> PandocLua NumResults
@@ -86,7 +95,7 @@ list = do
     zipWithM_ addEntry [1..] dirContents
   return 1
  where
-  addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua ()
+  addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> LuaE PandocError ()
   addEntry idx (fp, mimeType, contentLength) = do
     Lua.newtable
     Lua.push ("path" :: T.Text) *> Lua.push fp *> Lua.rawset (-3)

src/Text/Pandoc/Lua/Module/Pandoc.hs

@@ -15,29 +15,30 @@ module Text.Pandoc.Lua.Module.Pandoc
   ) where
 
 import Prelude hiding (read)
-import Control.Monad (when)
+import Control.Monad ((>=>), when)
 import Control.Monad.Except (throwError)
 import Data.Default (Default (..))
 import Data.Maybe (fromMaybe)
-import Foreign.Lua (Lua, NumResults, Optional, Peekable, Pushable)
+import HsLua as Lua hiding (pushModule)
+import HsLua.Class.Peekable (PeekError)
 import System.Exit (ExitCode (..))
 import Text.Pandoc.Class.PandocIO (runIO)
 import Text.Pandoc.Definition (Block, Inline)
-import Text.Pandoc.Lua.Filter (LuaFilter, SingletonsList (..), walkInlines,
+import Text.Pandoc.Lua.Filter (SingletonsList (..), walkInlines,
                                walkInlineLists, walkBlocks, walkBlockLists)
 import Text.Pandoc.Lua.Marshaling ()
+import Text.Pandoc.Lua.Marshaling.AST
 import Text.Pandoc.Lua.Marshaling.List (List (..))
 import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
                                   loadDefaultModule)
-import Text.Pandoc.Walk (Walkable)
 import Text.Pandoc.Options (ReaderOptions (readerExtensions))
 import Text.Pandoc.Process (pipeProcess)
 import Text.Pandoc.Readers (Reader (..), getReader)
+import Text.Pandoc.Walk (Walkable)
 
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import qualified Data.Text as T
-import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.Lua.Util as LuaUtil
 import Text.Pandoc.Error
 
@@ -48,23 +49,25 @@ pushModule = do
   loadDefaultModule "pandoc"
   addFunction "read" read
   addFunction "pipe" pipe
-  addFunction "walk_block" walk_block
-  addFunction "walk_inline" walk_inline
+  addFunction "walk_block" (walkElement peekBlock pushBlock)
+  addFunction "walk_inline" (walkElement peekInline pushInline)
   return 1
 
 walkElement :: (Walkable (SingletonsList Inline) a,
                 Walkable (SingletonsList Block) a,
                 Walkable (List Inline) a,
                 Walkable (List Block) a)
-            => a -> LuaFilter -> PandocLua a
-walkElement x f = liftPandocLua $
-  walkInlines f x >>= walkInlineLists f >>= walkBlocks f >>= walkBlockLists f
-
-walk_inline :: Inline -> LuaFilter -> PandocLua Inline
-walk_inline = walkElement
-
-walk_block :: Block -> LuaFilter -> PandocLua Block
-walk_block = walkElement
+            => 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
@@ -93,7 +96,9 @@ pipe command args input = liftPandocLua $ do
   (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
   case ec of
     ExitSuccess -> 1 <$ Lua.push output
-    ExitFailure n -> Lua.raiseError (PipeError (T.pack command) n output)
+    ExitFailure n -> do
+      pushPipeError (PipeError (T.pack command) n output)
+      Lua.error
 
 data PipeError = PipeError
   { pipeErrorCommand :: T.Text
@@ -101,15 +106,15 @@ data PipeError = PipeError
   , pipeErrorOutput :: BL.ByteString
   }
 
-instance Peekable PipeError where
-  peek idx =
+peekPipeError :: PeekError e => StackIndex -> LuaE e PipeError
+peekPipeError idx =
   PipeError
   <$> (Lua.getfield idx "command"    *> Lua.peek (-1) <* Lua.pop 1)
   <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1)
   <*> (Lua.getfield idx "output"     *> Lua.peek (-1) <* Lua.pop 1)
 
-instance Pushable PipeError where
-  push pipeErr = do
+pushPipeError :: PeekError e => Pusher e PipeError
+pushPipeError pipeErr = do
   Lua.newtable
   LuaUtil.addField "command" (pipeErrorCommand pipeErr)
   LuaUtil.addField "error_code" (pipeErrorCode pipeErr)
@@ -117,13 +122,18 @@ instance Pushable PipeError where
   pushPipeErrorMetaTable
   Lua.setmetatable (-2)
     where
-        pushPipeErrorMetaTable :: Lua ()
+      pushPipeErrorMetaTable :: PeekError e => LuaE e ()
       pushPipeErrorMetaTable = do
         v <- Lua.newmetatable "pandoc pipe error"
-          when v $ LuaUtil.addFunction "__tostring" pipeErrorMessage
+        when v $ do
+          pushName "__tostring"
+          pushHaskellFunction pipeErrorMessage
+          rawset (nth 3)
 
-        pipeErrorMessage :: PipeError -> Lua BL.ByteString
-        pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat
+      pipeErrorMessage :: PeekError e => LuaE e NumResults
+      pipeErrorMessage = do
+        (PipeError cmd errorCode output) <- peekPipeError (nthBottom 1)
+        pushByteString . BSL.toStrict . BSL.concat $
           [ BSL.pack "Error running "
           , BSL.pack $ T.unpack cmd
           , BSL.pack " (error code "
@@ -131,3 +141,4 @@ instance Pushable PipeError where
           , BSL.pack "): "
           , if output == mempty then BSL.pack "<no output>" else output
           ]
+        return (NumResults 1)

src/Text/Pandoc/Lua/Module/System.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {- |
    Module      : Text.Pandoc.Lua.Module.System
    Copyright   : © 2019-2021 Albert Krewinkel
@@ -12,22 +14,31 @@ module Text.Pandoc.Lua.Module.System
   ( pushModule
   ) where
 
-import Foreign.Lua (Lua, NumResults)
-import Foreign.Lua.Module.System (arch, env, getwd, os,
-                                  with_env, with_tmpdir, with_wd)
-import Text.Pandoc.Lua.Util (addFunction, addField)
+import HsLua hiding (pushModule)
+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 Foreign.Lua as Lua
+import qualified HsLua as Lua
 
 -- | Push the pandoc.system module on the Lua stack.
-pushModule :: Lua NumResults
+pushModule :: LuaE PandocError NumResults
 pushModule = do
-  Lua.newtable
-  addField "arch" arch
-  addField "os" os
-  addFunction "environment" env
-  addFunction "get_working_directory" getwd
-  addFunction "with_environment" with_env
-  addFunction "with_temporary_directory" with_tmpdir
-  addFunction "with_working_directory" with_wd
+  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

src/Text/Pandoc/Lua/Module/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {- |
    Module      : Text.Pandoc.Lua.Module.Types
    Copyright   : © 2019-2021 Albert Krewinkel
@@ -13,56 +14,41 @@ module Text.Pandoc.Lua.Module.Types
   ) where
 
 import Data.Version (Version)
-import Foreign.Lua (Lua, NumResults)
-import Text.Pandoc.Definition
-import Text.Pandoc.Lua.Marshaling.AST (LuaAttr, LuaListAttributes)
+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 Foreign.Lua as Lua
+import qualified HsLua as Lua
 
--- | Push the pandoc.system module on the Lua stack.
-pushModule :: Lua NumResults
+-- | Push the pandoc.types module on the Lua stack.
+pushModule :: LuaE PandocError NumResults
 pushModule = do
   Lua.newtable
-  addFunction "Version" (return :: Version -> Lua Version)
+  addFunction "Version" (return :: Version -> LuaE PandocError Version)
   pushCloneTable
-  Lua.setfield (Lua.nthFromTop 2) "clone"
+  Lua.setfield (Lua.nth 2) "clone"
   return 1
 
-pushCloneTable :: Lua NumResults
+pushCloneTable :: LuaE PandocError NumResults
 pushCloneTable = do
   Lua.newtable
-  addFunction "Attr" cloneAttr
-  addFunction "Block" cloneBlock
-  addFunction "Citation" cloneCitation
-  addFunction "Inline" cloneInline
-  addFunction "Meta" cloneMeta
-  addFunction "MetaValue" cloneMetaValue
-  addFunction "ListAttributes" cloneListAttributes
-  addFunction "Pandoc" clonePandoc
+  addFunction "Attr"      $ cloneWith peekAttr pushAttr
+  addFunction "Block"     $ cloneWith peekBlock pushBlock
+  addFunction "Citation"  $ cloneWith peekCitation Lua.push
+  addFunction "Inline"    $ cloneWith peekInline pushInline
+  addFunction "Meta"      $ cloneWith peekMeta Lua.push
+  addFunction "MetaValue" $ cloneWith peekMetaValue pushMetaValue
+  addFunction "ListAttributes" $ cloneWith peekListAttributes pushListAttributes
+  addFunction "Pandoc"    $ cloneWith peekPandoc pushPandoc
   return 1
 
-cloneAttr :: LuaAttr -> Lua LuaAttr
-cloneAttr = return
-
-cloneBlock :: Block -> Lua Block
-cloneBlock = return
-
-cloneCitation :: Citation -> Lua Citation
-cloneCitation = return
-
-cloneInline :: Inline -> Lua Inline
-cloneInline = return
-
-cloneListAttributes :: LuaListAttributes -> Lua LuaListAttributes
-cloneListAttributes = return
-
-cloneMeta :: Meta -> Lua Meta
-cloneMeta = return
-
-cloneMetaValue :: MetaValue -> Lua MetaValue
-cloneMetaValue = return
-
-clonePandoc :: Pandoc -> Lua Pandoc
-clonePandoc = return
+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)

src/Text/Pandoc/Lua/Module/Utils.hs

@@ -1,5 +1,7 @@
 {-# 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
+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" ""
 
--- | 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)
+    , defun "equals"
+      ### liftPure2 (==)
+      <#> parameter peekAstElement "AST element" "elem1" ""
+      <#> parameter peekAstElement "AST element" "elem2" ""
+      =#> functionResult pushBool "boolean" "true iff elem1 == elem2"
 
--- | 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)
+    , 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"
 
--- | 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
+    , 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."
+      ]
 
--- | 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
+    , 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"
-              (:[]) <$> Lua.popValue
-  JSONFilter.apply def args filterFile doc
+                          (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
 
--- | Calculate the hash of the given contents.
-sha1 :: BSL.ByteString
-     -> Lua T.Text
-sha1 = return . T.pack . SHA.showDigest . SHA.sha1
 
 -- | 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) <> "."
+    return $ SimpleTable capt aligns widths headers rows
+  blk -> Lua.failLua $ mconcat
+         [ "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
+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)
+       , "." ]

src/Text/Pandoc/Lua/Packages.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
 {- |
    Module      : Text.Pandoc.Lua.Packages
    Copyright   : Copyright © 2017-2021 Albert Krewinkel
@@ -13,12 +16,13 @@ module Text.Pandoc.Lua.Packages
   ) where
 
 import Control.Monad (forM_)
-import Foreign.Lua (NumResults)
+import HsLua (NumResults)
+import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule)
 
-import qualified Foreign.Lua as Lua
-import qualified Foreign.Lua.Module.Path as Path
-import qualified Foreign.Lua.Module.Text as Text
+import qualified HsLua as Lua
+import qualified HsLua.Module.Path as Path
+import qualified HsLua.Module.Text as Text
 import qualified Text.Pandoc.Lua.Module.Pandoc as Pandoc
 import qualified Text.Pandoc.Lua.Module.MediaBag as MediaBag
 import qualified Text.Pandoc.Lua.Module.System as System
@@ -30,8 +34,8 @@ installPandocPackageSearcher :: PandocLua ()
 installPandocPackageSearcher = liftPandocLua $ do
   Lua.getglobal' "package.searchers"
   shiftArray
-  Lua.pushHaskellFunction pandocPackageSearcher
-  Lua.rawseti (Lua.nthFromTop 2) 1
+  Lua.pushHaskellFunction $ Lua.toHaskellFunction pandocPackageSearcher
+  Lua.rawseti (Lua.nth 2) 1
   Lua.pop 1           -- remove 'package.searchers' from stack
  where
   shiftArray = forM_ [4, 3, 2, 1] $ \i -> do
@@ -42,14 +46,16 @@ installPandocPackageSearcher = liftPandocLua $ do
 pandocPackageSearcher :: String -> PandocLua NumResults
 pandocPackageSearcher pkgName =
   case pkgName of
-    "pandoc"          -> pushWrappedHsFun Pandoc.pushModule
-    "pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule
-    "pandoc.path"     -> pushWrappedHsFun Path.pushModule
-    "pandoc.system"   -> pushWrappedHsFun System.pushModule
-    "pandoc.types"    -> pushWrappedHsFun Types.pushModule
-    "pandoc.utils"    -> pushWrappedHsFun Utils.pushModule
-    "text"            -> pushWrappedHsFun Text.pushModule
-    "pandoc.List"     -> pushWrappedHsFun (loadDefaultModule pkgName)
+    "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)
     _                 -> reportPandocSearcherFailure
  where
   pushWrappedHsFun f = liftPandocLua $ do

src/Text/Pandoc/Lua/PandocLua.hs

@@ -28,20 +28,19 @@ module Text.Pandoc.Lua.PandocLua
 
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import Control.Monad.Except (MonadError (catchError, throwError))
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Foreign.Lua (Lua (..), NumResults, Pushable, ToHaskellFunction)
+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.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.ErrorConversion (errorConversion)
+import Text.Pandoc.Lua.Marshaling.CommonState (peekCommonState)
 
 import qualified Control.Monad.Catch as Catch
 import qualified Data.Text as T
-import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.Class.IO as IO
 
 -- | Type providing access to both, pandoc and Lua operations.
-newtype PandocLua a = PandocLua { unPandocLua :: Lua a }
+newtype PandocLua a = PandocLua { unPandocLua :: LuaE PandocError a }
   deriving
     ( Applicative
     , Functor
@@ -53,7 +52,7 @@ newtype PandocLua a = PandocLua { unPandocLua :: Lua a }
     )
 
 -- | Lift a @'Lua'@ operation into the @'PandocLua'@ type.
-liftPandocLua :: Lua a -> PandocLua a
+liftPandocLua :: LuaE PandocError a -> PandocLua a
 liftPandocLua = PandocLua
 
 -- | Evaluate a @'PandocLua'@ computation, running all contained Lua
@@ -62,7 +61,7 @@ runPandocLua :: (PandocMonad m, MonadIO m) => PandocLua a -> m a
 runPandocLua pLua = do
   origState <- getCommonState
   globals <- defaultGlobals
-  (result, newState) <- liftIO . Lua.run' errorConversion . unPandocLua $ do
+  (result, newState) <- liftIO . Lua.run . unPandocLua $ do
     putCommonState origState
     liftPandocLua $ setGlobals globals
     r <- pLua
@@ -71,17 +70,17 @@ runPandocLua pLua = do
   putCommonState newState
   return result
 
-instance {-# OVERLAPPING #-} ToHaskellFunction (PandocLua NumResults) where
-  toHsFun _narg = unPandocLua
+instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where
+  partialApply _narg = unPandocLua
 
-instance Pushable a => ToHaskellFunction (PandocLua a) where
-  toHsFun _narg x = 1 <$ (unPandocLua x >>= Lua.push)
+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 :: ToHaskellFunction a => String -> a -> PandocLua ()
+addFunction :: Exposable PandocError a => Name -> a -> PandocLua ()
 addFunction name fn = liftPandocLua $ do
-  Lua.push name
-  Lua.pushHaskellFunction fn
+  Lua.pushName name
+  Lua.pushHaskellFunction $ toHaskellFunction fn
   Lua.rawset (-3)
 
 -- | Load a pure Lua module included with pandoc. Leaves the result on
@@ -93,8 +92,8 @@ addFunction name fn = liftPandocLua $ do
 loadDefaultModule :: String -> PandocLua NumResults
 loadDefaultModule name = do
   script <- readDefaultDataFile (name <> ".lua")
-  status <- liftPandocLua $ Lua.dostring script
-  if status == Lua.OK
+  result <- liftPandocLua $ Lua.dostring script
+  if result == Lua.OK
     then return (1 :: NumResults)
     else do
       msg <- liftPandocLua Lua.popValue
@@ -135,7 +134,7 @@ instance PandocMonad PandocLua where
 
   getCommonState = PandocLua $ do
     Lua.getglobal "PANDOC_STATE"
-    Lua.peek Lua.stackTop
+    forcePeek $ peekCommonState Lua.top
   putCommonState = PandocLua . setGlobals . (:[]) . PANDOC_STATE
 
   logOutput = IO.logOutput

src/Text/Pandoc/Lua/Util.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
 {- |
    Module      : Text.Pandoc.Lua.Util
    Copyright   : © 2012-2021 John MacFarlane,
@@ -14,114 +17,91 @@ Lua utility functions.
 -}
 module Text.Pandoc.Lua.Util
   ( getTag
-  , rawField
   , addField
   , addFunction
-  , addValue
   , pushViaConstructor
-  , defineHowTo
-  , throwTopMessageAsError'
   , callWithTraceback
   , dofileWithTraceback
+  , pushViaConstr'
   ) where
 
 import Control.Monad (unless, when)
-import Data.Text (Text)
-import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
-                   , Status, ToHaskellFunction )
-import qualified Foreign.Lua as Lua
-import qualified Text.Pandoc.UTF8 as UTF8
-
--- | Get value behind key from table at given index.
-rawField :: Peekable a => StackIndex -> String -> Lua a
-rawField idx key = do
-  absidx <- Lua.absindex idx
-  Lua.push key
-  Lua.rawget absidx
-  Lua.popValue
+import HsLua
+import qualified HsLua as Lua
 
 -- | Add a value to the table at the top of the stack at a string-index.
-addField :: Pushable a => String -> a -> Lua ()
-addField = addValue
-
--- | Add a key-value pair to the table at the top of the stack.
-addValue :: (Pushable a, Pushable b) => a -> b -> Lua ()
-addValue key value = do
+addField :: (LuaError e, Pushable a) => String -> a -> LuaE e ()
+addField key value = do
   Lua.push key
   Lua.push value
-  Lua.rawset (Lua.nthFromTop 3)
+  Lua.rawset (Lua.nth 3)
 
--- | Add a function to the table at the top of the stack, using the given name.
-addFunction :: ToHaskellFunction a => String -> a -> Lua ()
+-- | 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 fn
+  Lua.pushHaskellFunction $ toHaskellFunction fn
   Lua.rawset (-3)
 
--- | Helper class for pushing a single value to the stack via a lua function.
--- See @pushViaCall@.
-class PushViaCall a where
-  pushViaCall' :: String -> Lua () -> NumArgs -> a
+-- | Helper class for pushing a single value to the stack via a lua
+-- function. See @pushViaCall@.
+class LuaError e => PushViaCall e a where
+  pushViaCall' :: LuaError e => Name -> LuaE e () -> NumArgs -> a
 
-instance PushViaCall (Lua ()) where
+instance LuaError e => PushViaCall e (LuaE e ()) where
   pushViaCall' fn pushArgs num = do
-    Lua.push fn
+    Lua.pushName @e fn
     Lua.rawget Lua.registryindex
     pushArgs
     Lua.call num 1
 
-instance (Pushable a, PushViaCall b) => PushViaCall (a -> b) where
+instance (LuaError e, Pushable a, PushViaCall e b) =>
+         PushViaCall e (a -> b) where
   pushViaCall' fn pushArgs num x =
-    pushViaCall' fn (pushArgs *> Lua.push x) (num + 1)
+    pushViaCall' @e fn (pushArgs *> Lua.push x) (num + 1)
 
 -- | Push an value to the stack via a lua function. The lua function is called
 -- with all arguments that are passed to this function and is expected to return
 -- a single value.
-pushViaCall :: PushViaCall a => String -> a
-pushViaCall fn = pushViaCall' fn (return ()) 0
+pushViaCall :: forall e a. LuaError e => PushViaCall e a => Name -> a
+pushViaCall fn = pushViaCall' @e fn (return ()) 0
 
 -- | Call a pandoc element constructor within Lua, passing all given arguments.
-pushViaConstructor :: PushViaCall a => String -> a
-pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
+pushViaConstructor :: forall e a. LuaError e => PushViaCall e a => Name -> a
+pushViaConstructor pandocFn = pushViaCall @e ("pandoc." <> pandocFn)
 
 -- | 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 :: StackIndex -> Lua String
+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.push ("tag" :: Text)
-  Lua.rawget (Lua.nthFromTop 2)
-  Lua.tostring Lua.stackTop <* Lua.pop 2 >>= \case
-    Nothing -> Lua.throwMessage "untagged value"
-    Just x -> return (UTF8.toString x)
+    Lua.pushName "tag"
+    Lua.rawget (Lua.nth 2)
+  Lua.peekName Lua.top `lastly` Lua.pop 2  -- table/metatable and `tag` field
 
--- | Modify the message at the top of the stack before throwing it as an
--- Exception.
-throwTopMessageAsError' :: (String -> String) -> Lua a
-throwTopMessageAsError' modifier = do
-  msg <- Lua.tostring' Lua.stackTop
-  Lua.pop 2 -- remove error and error string pushed by tostring'
-  Lua.throwMessage (modifier (UTF8.toString msg))
-
--- | Mark the context of a Lua computation for better error reporting.
-defineHowTo :: String -> Lua a -> Lua a
-defineHowTo ctx op = Lua.errorConversion >>= \ec ->
-  Lua.addContextToException ec ("Could not " <> ctx <> ": ") op
+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 :: NumArgs -> NumResults -> Lua Status
+pcallWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e Status
 pcallWithTraceback nargs nresults = do
-  let traceback' :: Lua NumResults
+  let traceback' :: LuaError e => LuaE e NumResults
       traceback' = do
         l <- Lua.state
-        msg <- Lua.tostring' (Lua.nthFromBottom 1)
-        Lua.traceback l (Just (UTF8.toString msg)) 2
+        msg <- Lua.tostring' (Lua.nthBottom 1)
+        Lua.traceback l (Just msg) 2
         return 1
-  tracebackIdx <- Lua.absindex (Lua.nthFromTop (Lua.fromNumArgs nargs + 1))
+  tracebackIdx <- Lua.absindex (Lua.nth (Lua.fromNumArgs nargs + 1))
   Lua.pushHaskellFunction traceback'
   Lua.insert tracebackIdx
   result <- Lua.pcall nargs nresults (Just tracebackIdx)
@@ -129,15 +109,15 @@ pcallWithTraceback nargs nresults = do
   return result
 
 -- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
-callWithTraceback :: NumArgs -> NumResults -> Lua ()
+callWithTraceback :: LuaError e => NumArgs -> NumResults -> LuaE e ()
 callWithTraceback nargs nresults = do
   result <- pcallWithTraceback nargs nresults
   when (result /= Lua.OK)
-    Lua.throwTopMessage
+    Lua.throwErrorAsException
 
 -- | Run the given string as a Lua program, while also adding a traceback to the
 -- error message if an error occurs.
-dofileWithTraceback :: FilePath -> Lua Status
+dofileWithTraceback :: LuaError e => FilePath -> LuaE e Status
 dofileWithTraceback fp = do
   loadRes <- Lua.loadfile fp
   case loadRes of

src/Text/Pandoc/Writers/Custom.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
 {- |
    Module      : Text.Pandoc.Writers.Custom
    Copyright   : Copyright (C) 2012-2021 John MacFarlane
@@ -10,7 +13,7 @@
    Portability : portable
 
 Conversion of 'Pandoc' documents to custom markup using
-a lua writer.
+a Lua writer.
 -}
 module Text.Pandoc.Writers.Custom ( writeCustom ) where
 import Control.Arrow ((***))
@@ -20,7 +23,8 @@ import Data.List (intersperse)
 import qualified Data.Map as M
 import qualified Data.Text as T
 import Data.Text (Text, pack)
-import Foreign.Lua (Lua, Pushable)
+import HsLua as Lua hiding (Operation (Div), render)
+import HsLua.Class.Peekable (PeekError)
 import Text.DocLayout (render, literal)
 import Control.Monad.IO.Class (MonadIO)
 import Text.Pandoc.Definition
@@ -31,39 +35,39 @@ import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Templates (renderTemplate)
 import Text.Pandoc.Writers.Shared
 
-import qualified Foreign.Lua as Lua
-
 attrToMap :: Attr -> M.Map T.Text T.Text
 attrToMap (id',classes,keyvals) = M.fromList
     $ ("id", id')
     : ("class", T.unwords classes)
     : keyvals
 
-newtype Stringify a = Stringify a
+newtype Stringify e a = Stringify a
 
-instance Pushable (Stringify Format) where
+instance Pushable (Stringify e Format) where
   push (Stringify (Format f)) = Lua.push (T.toLower f)
 
-instance Pushable (Stringify [Inline]) where
-  push (Stringify ils) = Lua.push =<< inlineListToCustom ils
+instance PeekError e => Pushable (Stringify e [Inline]) where
+  push (Stringify ils) = Lua.push =<<
+    changeErrorType ((inlineListToCustom @e) ils)
 
-instance Pushable (Stringify [Block]) where
-  push (Stringify blks) = Lua.push =<< blockListToCustom blks
+instance PeekError e => Pushable (Stringify e [Block]) where
+  push (Stringify blks) = Lua.push =<<
+    changeErrorType ((blockListToCustom @e) blks)
 
-instance Pushable (Stringify MetaValue) where
-  push (Stringify (MetaMap m))       = Lua.push (fmap Stringify m)
-  push (Stringify (MetaList xs))     = Lua.push (map Stringify xs)
+instance PeekError e => Pushable (Stringify e MetaValue) where
+  push (Stringify (MetaMap m))       = Lua.push (fmap (Stringify @e) m)
+  push (Stringify (MetaList xs))     = Lua.push (map (Stringify @e) xs)
   push (Stringify (MetaBool x))      = Lua.push x
   push (Stringify (MetaString s))    = Lua.push s
-  push (Stringify (MetaInlines ils)) = Lua.push (Stringify ils)
-  push (Stringify (MetaBlocks bs))   = Lua.push (Stringify bs)
+  push (Stringify (MetaInlines ils)) = Lua.push (Stringify @e ils)
+  push (Stringify (MetaBlocks bs))   = Lua.push (Stringify @e bs)
 
-instance Pushable (Stringify Citation) where
+instance PeekError e => Pushable (Stringify e Citation) where
   push (Stringify cit) = do
     Lua.createtable 6 0
     addField "citationId" $ citationId cit
-    addField "citationPrefix" . Stringify $ citationPrefix cit
-    addField "citationSuffix" . Stringify $ citationSuffix cit
+    addField "citationPrefix" . Stringify @e $ citationPrefix cit
+    addField "citationSuffix" . Stringify @e $ citationSuffix cit
     addField "citationMode" $ show (citationMode cit)
     addField "citationNoteNum" $ citationNoteNum cit
     addField "citationHash" $ citationHash cit
@@ -77,7 +81,7 @@ instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
     Lua.newtable
     Lua.push k
     Lua.push v
-    Lua.rawset (Lua.nthFromTop 3)
+    Lua.rawset (Lua.nth 3)
 
 -- | Convert Pandoc to custom markup.
 writeCustom :: (PandocMonad m, MonadIO m)
@@ -92,7 +96,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
     -- check for error in lua script (later we'll change the return type
     -- to handle this more gracefully):
     when (stat /= Lua.OK)
-      Lua.throwTopMessage
+      Lua.throwErrorAsException
     rendered <- docToCustom opts doc
     context <- metaToContext opts
                (fmap (literal . pack) . blockListToCustom)
@@ -107,126 +111,132 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
         Just tpl -> render Nothing $
                     renderTemplate tpl $ setField "body" body context
 
-docToCustom :: WriterOptions -> Pandoc -> Lua String
+docToCustom :: forall e. PeekError e
+            => WriterOptions -> Pandoc -> LuaE e String
 docToCustom opts (Pandoc (Meta metamap) blocks) = do
   body <- blockListToCustom blocks
-  Lua.callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts)
+  invoke @e "Doc" body (fmap (Stringify @e) metamap) (writerVariables opts)
 
 -- | Convert Pandoc block element to Custom.
-blockToCustom :: Block         -- ^ Block element
-              -> Lua String
+blockToCustom :: forall e. PeekError e
+              => Block         -- ^ Block element
+              -> LuaE e String
 
 blockToCustom Null = return ""
 
-blockToCustom (Plain inlines) = Lua.callFunc "Plain" (Stringify inlines)
+blockToCustom (Plain inlines) = invoke @e "Plain" (Stringify @e inlines)
 
 blockToCustom (Para [Image attr txt (src,tit)]) =
-  Lua.callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr)
+  invoke @e "CaptionedImage" src tit (Stringify @e txt) (attrToMap attr)
 
-blockToCustom (Para inlines) = Lua.callFunc "Para" (Stringify inlines)
+blockToCustom (Para inlines) = invoke @e "Para" (Stringify @e inlines)
 
 blockToCustom (LineBlock linesList) =
-  Lua.callFunc "LineBlock" (map Stringify linesList)
+  invoke @e "LineBlock" (map (Stringify @e) linesList)
 
 blockToCustom (RawBlock format str) =
-  Lua.callFunc "RawBlock" (Stringify format) str
+  invoke @e "RawBlock" (Stringify @e format) str
 
-blockToCustom HorizontalRule = Lua.callFunc "HorizontalRule"
+blockToCustom HorizontalRule = invoke @e "HorizontalRule"
 
 blockToCustom (Header level attr inlines) =
-  Lua.callFunc "Header" level (Stringify inlines) (attrToMap attr)
+  invoke @e "Header" level (Stringify @e inlines) (attrToMap attr)
 
 blockToCustom (CodeBlock attr str) =
-  Lua.callFunc "CodeBlock" str (attrToMap attr)
+  invoke @e "CodeBlock" str (attrToMap attr)
 
 blockToCustom (BlockQuote blocks) =
-  Lua.callFunc "BlockQuote" (Stringify blocks)
+  invoke @e "BlockQuote" (Stringify @e blocks)
 
 blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
   let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
       aligns' = map show aligns
-      capt' = Stringify capt
-      headers' = map Stringify headers
-      rows' = map (map Stringify) rows
-  in Lua.callFunc "Table" capt' aligns' widths headers' rows'
+      capt' = Stringify @e capt
+      headers' = map (Stringify @e) headers
+      rows' = map (map (Stringify @e)) rows
+  in invoke @e "Table" capt' aligns' widths headers' rows'
 
 blockToCustom (BulletList items) =
-  Lua.callFunc "BulletList" (map Stringify items)
+  invoke @e "BulletList" (map (Stringify @e) items)
 
 blockToCustom (OrderedList (num,sty,delim) items) =
-  Lua.callFunc "OrderedList" (map Stringify items) num (show sty) (show delim)
+  invoke @e "OrderedList" (map (Stringify @e) items) num (show sty) (show delim)
 
 blockToCustom (DefinitionList items) =
-  Lua.callFunc "DefinitionList"
-               (map (KeyValue . (Stringify *** map Stringify)) items)
+  invoke @e "DefinitionList"
+               (map (KeyValue . (Stringify @e *** map (Stringify @e))) items)
 
 blockToCustom (Div attr items) =
-  Lua.callFunc "Div" (Stringify items) (attrToMap attr)
+  invoke @e "Div" (Stringify @e items) (attrToMap attr)
 
 -- | Convert list of Pandoc block elements to Custom.
-blockListToCustom :: [Block]       -- ^ List of block elements
-                  -> Lua String
+blockListToCustom :: forall e. PeekError e
+                  => [Block]       -- ^ List of block elements
+                  -> LuaE e String
 blockListToCustom xs = do
-  blocksep <- Lua.callFunc "Blocksep"
+  blocksep <- invoke @e "Blocksep"
   bs <- mapM blockToCustom xs
   return $ mconcat $ intersperse blocksep bs
 
 -- | Convert list of Pandoc inline elements to Custom.
-inlineListToCustom :: [Inline] -> Lua String
+inlineListToCustom :: forall e. PeekError e => [Inline] -> LuaE e String
 inlineListToCustom lst = do
-  xs <- mapM inlineToCustom lst
+  xs <- mapM (inlineToCustom @e) lst
   return $ mconcat xs
 
 -- | Convert Pandoc inline element to Custom.
-inlineToCustom :: Inline -> Lua String
+inlineToCustom :: forall e. PeekError e => Inline -> LuaE e String
 
-inlineToCustom (Str str) = Lua.callFunc "Str" str
+inlineToCustom (Str str) = invoke @e "Str" str
 
-inlineToCustom Space = Lua.callFunc "Space"
+inlineToCustom Space = invoke @e "Space"
 
-inlineToCustom SoftBreak = Lua.callFunc "SoftBreak"
+inlineToCustom SoftBreak = invoke @e "SoftBreak"
 
-inlineToCustom (Emph lst) = Lua.callFunc "Emph" (Stringify lst)
+inlineToCustom (Emph lst) = invoke @e "Emph" (Stringify @e lst)
 
-inlineToCustom (Underline lst) = Lua.callFunc "Underline" (Stringify lst)
+inlineToCustom (Underline lst) = invoke @e "Underline" (Stringify @e lst)
 
-inlineToCustom (Strong lst) = Lua.callFunc "Strong" (Stringify lst)
+inlineToCustom (Strong lst) = invoke @e "Strong" (Stringify @e lst)
 
-inlineToCustom (Strikeout lst) = Lua.callFunc "Strikeout" (Stringify lst)
+inlineToCustom (Strikeout lst) = invoke @e "Strikeout" (Stringify @e lst)
 
-inlineToCustom (Superscript lst) = Lua.callFunc "Superscript" (Stringify lst)
+inlineToCustom (Superscript lst) = invoke @e "Superscript" (Stringify @e lst)
 
-inlineToCustom (Subscript lst) = Lua.callFunc "Subscript" (Stringify lst)
+inlineToCustom (Subscript lst) = invoke @e "Subscript" (Stringify @e lst)
 
-inlineToCustom (SmallCaps lst) = Lua.callFunc "SmallCaps" (Stringify lst)
+inlineToCustom (SmallCaps lst) = invoke @e "SmallCaps" (Stringify @e lst)
 
-inlineToCustom (Quoted SingleQuote lst) = Lua.callFunc "SingleQuoted" (Stringify lst)
+inlineToCustom (Quoted SingleQuote lst) =
+  invoke @e "SingleQuoted" (Stringify @e lst)
 
-inlineToCustom (Quoted DoubleQuote lst) = Lua.callFunc "DoubleQuoted" (Stringify lst)
+inlineToCustom (Quoted DoubleQuote lst) =
+  invoke @e "DoubleQuoted" (Stringify @e lst)
 
-inlineToCustom (Cite cs lst) = Lua.callFunc "Cite" (Stringify lst) (map Stringify cs)
+inlineToCustom (Cite cs lst) =
+  invoke @e "Cite" (Stringify @e lst) (map (Stringify @e) cs)
 
 inlineToCustom (Code attr str) =
-  Lua.callFunc "Code" str (attrToMap attr)
+  invoke @e "Code" str (attrToMap attr)
 
 inlineToCustom (Math DisplayMath str) =
-  Lua.callFunc "DisplayMath" str
+  invoke @e "DisplayMath" str
 
 inlineToCustom (Math InlineMath str) =
-  Lua.callFunc "InlineMath" str
+  invoke @e "InlineMath" str
 
 inlineToCustom (RawInline format str) =
-  Lua.callFunc "RawInline" (Stringify format) str
+  invoke @e "RawInline" (Stringify @e format) str
 
-inlineToCustom LineBreak = Lua.callFunc "LineBreak"
+inlineToCustom LineBreak = invoke @e "LineBreak"
 
 inlineToCustom (Link attr txt (src,tit)) =
-  Lua.callFunc "Link" (Stringify txt) src tit (attrToMap attr)
+  invoke @e "Link" (Stringify @e txt) src tit (attrToMap attr)
 
 inlineToCustom (Image attr alt (src,tit)) =
-  Lua.callFunc "Image" (Stringify alt) src tit (attrToMap attr)
+  invoke @e "Image" (Stringify @e alt) src tit (attrToMap attr)
 
-inlineToCustom (Note contents) = Lua.callFunc "Note" (Stringify contents)
+inlineToCustom (Note contents) = invoke @e "Note" (Stringify @e contents)
 
 inlineToCustom (Span attr items) =
-  Lua.callFunc "Span" (Stringify items) (attrToMap attr)
+  invoke @e "Span" (Stringify @e items) (attrToMap attr)

stack.yaml

@@ -12,6 +12,19 @@ extra-deps:
 - doctemplates-0.10
 - emojis-0.1.2
 - doclayout-0.3.1.1
+- hslua-2.0.0
+- hslua-classes-2.0.0
+- hslua-core-2.0.0
+- hslua-marshalling-2.0.0
+- hslua-module-path-1.0.0
+- hslua-module-system-1.0.0
+- hslua-module-text-1.0.0
+- hslua-module-version-1.0.0
+- hslua-objectorientation-2.0.0
+- hslua-packaging-2.0.0
+- lua-2.0.0
+- tasty-hslua-1.0.0
+- tasty-lua-1.0.0
 - git: https://github.com/jgm/pandoc-types.git
   commit: 99402a46361a3e52805935b1fbe9dfe54f852d6a
 - git: https://github.com/jgm/texmath.git
@@ -26,5 +39,3 @@ ghc-options:
 resolver: lts-18.10
 nix:
   packages: [zlib]
-
-

test/Tests/Lua.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
 {- |
    Module      : Tests.Lua
    Copyright   : © 2017-2021 Albert Krewinkel
@@ -14,9 +15,10 @@ Unit and integration tests for pandoc's Lua subsystem.
 module Tests.Lua ( runLuaTest, tests ) where
 
 import Control.Monad (when)
+import HsLua as Lua hiding (Operation (Div), error)
 import System.FilePath ((</>))
 import Test.Tasty (TestTree, localOption)
-import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
+import Test.Tasty.HUnit (Assertion, HasCallStack, assertEqual, testCase)
 import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
 import Text.Pandoc.Arbitrary ()
 import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
@@ -25,8 +27,8 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
                             singleQuoted, space, str, strong,
                             HasMeta (setMeta))
 import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
-import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
-                               Attr, Meta, Pandoc, pandocTypesVersion)
+import Text.Pandoc.Definition (Attr, Block (BlockQuote, Div, Para), Pandoc,
+                               Inline (Emph, Str), Meta, pandocTypesVersion)
 import Text.Pandoc.Error (PandocError (PandocLuaError))
 import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
 import Text.Pandoc.Lua (runLua)
@@ -34,23 +36,22 @@ import Text.Pandoc.Options (def)
 import Text.Pandoc.Shared (pandocVersion)
 
 import qualified Control.Monad.Catch as Catch
-import qualified Foreign.Lua as Lua
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 
 tests :: [TestTree]
 tests = map (localOption (QuickCheckTests 20))
   [ testProperty "inline elements can be round-tripped through the lua stack" $
-    \x -> ioProperty (roundtripEqual (x::Inline))
+    ioProperty . roundtripEqual @Inline
 
   , testProperty "block elements can be round-tripped through the lua stack" $
-    \x -> ioProperty (roundtripEqual (x::Block))
+    ioProperty . roundtripEqual @Block
 
   , testProperty "meta blocks can be round-tripped through the lua stack" $
-    \x -> ioProperty (roundtripEqual (x::Meta))
+    ioProperty . roundtripEqual @Meta
 
   , testProperty "documents can be round-tripped through the lua stack" $
-    \x -> ioProperty (roundtripEqual (x::Pandoc))
+    ioProperty . roundtripEqual @Pandoc
 
   , testCase "macro expansion via filter" $
     assertFilterConversion "a '{{helloworld}}' string is expanded"
@@ -163,12 +164,12 @@ tests = map (localOption (QuickCheckTests 20))
       Lua.getglobal "PANDOC_VERSION"
       Lua.liftIO .
         assertEqual "pandoc version is wrong" (TE.encodeUtf8 pandocVersion)
-        =<< Lua.tostring' Lua.stackTop
+        =<< Lua.tostring' Lua.top
 
   , testCase "Pandoc types version is set" . runLuaTest $ do
       Lua.getglobal "PANDOC_API_VERSION"
       Lua.liftIO . assertEqual "pandoc-types version is wrong" pandocTypesVersion
-        =<< Lua.peek Lua.stackTop
+        =<< Lua.peek Lua.top
 
   , testCase "require file" $
     assertFilterConversion "requiring file failed"
@@ -177,38 +178,47 @@ tests = map (localOption (QuickCheckTests 20))
       (doc $ para (str . T.pack $ "lua" </> "require-file.lua"))
 
   , testCase "Allow singleton inline in constructors" . runLuaTest $ do
-      Lua.liftIO . assertEqual "Not the expected Emph" (Emph [Str "test"])
-        =<< Lua.callFunc "pandoc.Emph" (Str "test")
-      Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
-        =<< Lua.callFunc "pandoc.Para" ("test" :: String)
+      Lua.liftIO . assertEqual "Not the expected Emph"
+        (Emph [Str "test"]) =<< do
+        Lua.OK <- Lua.dostring "return pandoc.Emph"
+        Lua.push @Inline (Str "test")
+        Lua.call 1 1
+        Lua.peek @Inline top
+      Lua.liftIO . assertEqual "Unexpected element"
+        (Para [Str "test"]) =<< do
+        Lua.getglobal' "pandoc.Para"
+        Lua.pushString "test"
+        Lua.call 1 1
+        Lua.peek @Block top
       Lua.liftIO . assertEqual "Unexptected element"
         (BlockQuote [Para [Str "foo"]]) =<< (
         do
           Lua.getglobal' "pandoc.BlockQuote"
           Lua.push (Para [Str "foo"])
           _ <- Lua.call 1 1
-          Lua.peek Lua.stackTop
+          Lua.peek @Block Lua.top
         )
 
   , testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
       Lua.push (Div ("hi", ["moin"], [])
                 [Para [Str "ignored"]])
-      Lua.getfield Lua.stackTop "attr"
+      Lua.getfield Lua.top "attr"
       Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
-        =<< Lua.peek Lua.stackTop
+        =<< Lua.peek Lua.top
 
   , testCase "module `pandoc.system` is present" . runLuaTest $ do
       Lua.getglobal' "pandoc.system"
-      ty <- Lua.ltype Lua.stackTop
+      ty <- Lua.ltype Lua.top
       Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
 
   , testCase "informative error messages" . runLuaTest $ do
       Lua.pushboolean True
-      eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
+      -- Lua.newtable
+      eitherPandoc <- Catch.try (peek @Pandoc Lua.top)
       case eitherPandoc of
         Left (PandocLuaError msg) -> do
-          let expectedMsg = "Could not get Pandoc value: "
-                            <> "table expected, got boolean"
+          let expectedMsg = "table expected, got boolean\n"
+                <> "\twhile retrieving Pandoc value"
           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."
@@ -221,19 +231,20 @@ assertFilterConversion msg filterPath docIn expectedDoc = do
     applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
   assertEqual msg expectedDoc actualDoc
 
-roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
+roundtripEqual :: forall a. (Eq a, Lua.Pushable a, Lua.Peekable a)
+               => a -> IO Bool
 roundtripEqual x = (x ==) <$> roundtripped
  where
-  roundtripped :: Lua.Peekable a => IO a
+  roundtripped :: IO a
   roundtripped = runLuaTest $ do
     oldSize <- Lua.gettop
     Lua.push x
     size <- Lua.gettop
     when (size - oldSize /= 1) $
       error ("not exactly one additional element on the stack: " ++ show size)
-    Lua.peek (-1)
+    Lua.peek Lua.top
 
-runLuaTest :: Lua.Lua a -> IO a
+runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a
 runLuaTest op = runIOorExplode $ do
   setUserDataDir (Just "../data")
   res <- runLua op

test/lua/module/pandoc-types.lua

@@ -55,31 +55,6 @@ return {
       end),
     },
 
-    group 'list-like behavior' {
-      test('can access version component numbers', function ()
-        local version = Version '2.7.3'
-        assert.is_nil(version[0])
-        assert.are_equal(version[1], 2)
-        assert.are_equal(version[2], 7)
-        assert.are_equal(version[3], 3)
-      end),
-      test('can be iterated over', function ()
-        local version_list = {2, 7, 3}
-        local final_index = 0
-        for i, v in pairs(Version(version_list)) do
-          assert.are_equal(v, version_list[i])
-          final_index = i
-        end
-        assert.are_equal(final_index, 3)
-      end),
-      test('length is the number of components', function ()
-        assert.are_equal(#(Version '0'), 1)
-        assert.are_equal(#(Version '1.6'), 2)
-        assert.are_equal(#(Version '8.7.5'), 3)
-        assert.are_equal(#(Version '2.9.1.5'), 4)
-      end)
-    },
-
     group 'conversion to string' {
       test('converting from and to string is a noop', function ()
         local version_string = '1.19.4'