{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Pandoc
   Copyright   : Copyright © 2017-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Pandoc module for lua.
-}
module Text.Pandoc.Lua.Module.Pandoc
  ( pushModule
  , documentedModule
  ) where

import Prelude hiding (read)
import Control.Applicative ((<|>))
import Control.Monad (forM_, when)
import Control.Monad.Catch (catch, throwM)
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (Proxy))
import HsLua hiding (pushModule)
import System.Exit (ExitCode (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Lua.Orphans ()
import Text.Pandoc.Lua.Marshal.AST
import Text.Pandoc.Lua.Marshal.Filter (peekFilter)
import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions
                                             , pushReaderOptions)
import Text.Pandoc.Lua.Marshal.Sources (peekSources)
import Text.Pandoc.Lua.Marshal.WriterOptions ( peekWriterOptions
                                             , pushWriterOptions)
import Text.Pandoc.Lua.Module.Utils (sha1)
import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua), liftPandocLua)
import Text.Pandoc.Options ( ReaderOptions (readerExtensions)
                           , WriterOptions (writerExtensions) )
import Text.Pandoc.Process (pipeProcess)
import Text.Pandoc.Readers (Reader (..), getReader, readers)
import Text.Pandoc.Sources (toSources)
import Text.Pandoc.Writers (Writer (..), getWriter, writers)

import qualified HsLua as Lua
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Text.Pandoc.UTF8 as UTF8

-- | Push the "pandoc" package to the Lua stack. Requires the `List`
-- module to be loadable.
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Module e -> LuaE e ()
Lua.pushModule Module PandocError
documentedModule
  forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1

documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc"
  , moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
    [ Text
"Lua functions for pandoc scripts; includes constructors for"
    , Text
"document elements, functions to parse text in a given"
    , Text
"format, and functions to filter and modify a subtree."
    ]
  , moduleFields :: [Field PandocError]
moduleFields = Field PandocError
readersField forall a. a -> [a] -> [a]
: Field PandocError
writersField forall a. a -> [a] -> [a]
:
                   forall e. [Field e]
stringConstants forall a. [a] -> [a] -> [a]
++ [Field PandocError
inlineField, Field PandocError
blockField]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions = forall a. Monoid a => [a] -> a
mconcat
      [ [DocumentedFunction PandocError]
functions
      , forall e. LuaError e => [DocumentedFunction e]
otherConstructors
      , forall e. LuaError e => [DocumentedFunction e]
blockConstructors
      , forall e. LuaError e => [DocumentedFunction e]
inlineConstructors
      , forall e. LuaError e => [DocumentedFunction e]
metaValueConstructors
      ]
  }

-- | Set of input formats accepted by @read@.
readersField :: Field PandocError
readersField :: Field PandocError
readersField = Field
  { fieldName :: Text
fieldName = Text
"readers"
  , fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unlines
    [ Text
"Set of formats that pandoc can parse. All keys in this table can"
    , Text
"be used as the `format` value in `pandoc.read`."
    ]
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = forall e a. LuaError e => Pusher e a -> Pusher e (Set a)
pushSet forall e. Pusher e Text
pushText forall a b. (a -> b) -> a -> b
$
                     forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall (m :: * -> *). PandocMonad m => [(Text, Reader m)]
readers @PandocLua))
  }

-- | Set of input formats accepted by @write@.
writersField :: Field PandocError
writersField :: Field PandocError
writersField = Field
  { fieldName :: Text
fieldName = Text
"writers"
  , fieldDescription :: Text
fieldDescription = [Text] -> Text
T.unlines
    [ Text
"Set of formats that pandoc can generate. All keys in this table"
    , Text
"can be used as the `format` value in `pandoc.write`."
    ]
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = forall e a. LuaError e => Pusher e a -> Pusher e (Set a)
pushSet forall e. Pusher e Text
pushText forall a b. (a -> b) -> a -> b
$
                     forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall (m :: * -> *). PandocMonad m => [(Text, Writer m)]
writers @PandocLua))
  }

-- | Inline table field
inlineField :: Field PandocError
inlineField :: Field PandocError
inlineField = Field
  { fieldName :: Text
fieldName = Text
"Inline"
  , fieldDescription :: Text
fieldDescription = Text
"Inline constructors, nested under 'constructors'."
  -- the nesting happens for historical reasons and should probably be
  -- changed.
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable forall e. LuaError e => [DocumentedFunction e]
inlineConstructors
  }

-- | @Block@ module field
blockField :: Field PandocError
blockField :: Field PandocError
blockField = Field
  { fieldName :: Text
fieldName = Text
"Block"
  , fieldDescription :: Text
fieldDescription = Text
"Inline constructors, nested under 'constructors'."
  -- the nesting happens for historical reasons and should probably be
  -- changed.
  , fieldPushValue :: LuaE PandocError ()
fieldPushValue = [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable forall e. LuaError e => [DocumentedFunction e]
blockConstructors
  }

pushWithConstructorsSubtable :: [DocumentedFunction PandocError]
                             -> LuaE PandocError ()
pushWithConstructorsSubtable :: [DocumentedFunction PandocError] -> LuaE PandocError ()
pushWithConstructorsSubtable [DocumentedFunction PandocError]
constructors = do
  forall e. LuaE e ()
newtable -- Field table
  forall e. LuaE e ()
newtable -- constructor table
  forall e. Name -> LuaE e ()
pushName Name
"constructor" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
4)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DocumentedFunction PandocError]
constructors forall a b. (a -> b) -> a -> b
$ \DocumentedFunction PandocError
fn -> do
    forall e. Name -> LuaE e ()
pushName (forall e. DocumentedFunction e -> Name
functionName DocumentedFunction PandocError
fn)
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
pushDocumentedFunction DocumentedFunction PandocError
fn
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  forall e. Int -> LuaE e ()
pop Int
1 -- pop constructor table

otherConstructors :: LuaError e => [DocumentedFunction e]
otherConstructors :: forall e. LuaError e => [DocumentedFunction e]
otherConstructors =
  [ forall e. LuaError e => DocumentedFunction e
mkPandoc
  , forall e. LuaError e => DocumentedFunction e
mkMeta
  , forall e. LuaError e => DocumentedFunction e
mkAttr
  , forall e. LuaError e => DocumentedFunction e
mkAttributeList
  , forall e. LuaError e => DocumentedFunction e
mkBlocks
  , forall e. LuaError e => DocumentedFunction e
mkCitation
  , forall e. LuaError e => DocumentedFunction e
mkCell
  , forall e. LuaError e => DocumentedFunction e
mkRow
  , forall e. LuaError e => DocumentedFunction e
mkTableHead
  , forall e. LuaError e => DocumentedFunction e
mkTableFoot
  , forall e. LuaError e => DocumentedFunction e
mkInlines
  , forall e. LuaError e => DocumentedFunction e
mkListAttributes
  , forall e. LuaError e => DocumentedFunction e
mkSimpleTable

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"ReaderOptions"
    ### liftPure id
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e ReaderOptions
peekReaderOptions Text
"ReaderOptions|table" Text
"opts" Text
"reader options"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e ReaderOptions
pushReaderOptions Text
"ReaderOptions" Text
"new object"
    #? "Creates a new ReaderOptions value."

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"WriterOptions"
    ### liftPure id
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e WriterOptions
peekWriterOptions Text
"WriterOptions|table" Text
"opts"
          Text
"writer options"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e WriterOptions
pushWriterOptions Text
"WriterOptions" Text
"new object"
    #? "Creates a new WriterOptions value."
  ]

stringConstants :: [Field e]
stringConstants :: forall e. [Field e]
stringConstants =
  let constrs :: forall a. Data a => Proxy a -> [String]
      constrs :: forall a. Data a => Proxy a -> [String]
constrs Proxy a
_ = forall a b. (a -> b) -> [a] -> [b]
map Constr -> String
showConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf @a forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => a
undefined
      nullaryConstructors :: [String]
nullaryConstructors = forall a. Monoid a => [a] -> a
mconcat
        [ forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @ListNumberStyle)
        , forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @ListNumberDelim)
        , forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @QuoteType)
        , forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @MathType)
        , forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @Alignment)
        , forall a. Data a => Proxy a -> [String]
constrs (forall {k} (t :: k). Proxy t
Proxy @CitationMode)
        ]
      toField :: String -> Field e
toField String
s = Field
        { fieldName :: Text
fieldName = String -> Text
T.pack String
s
        , fieldDescription :: Text
fieldDescription = String -> Text
T.pack String
s
        , fieldPushValue :: LuaE e ()
fieldPushValue = forall e. String -> LuaE e ()
pushString String
s
        }
  in forall a b. (a -> b) -> [a] -> [b]
map forall {e}. String -> Field e
toField [String]
nullaryConstructors

functions :: [DocumentedFunction PandocError]
functions :: [DocumentedFunction PandocError]
functions =
  [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"pipe"
    ### (\command args input -> do
            (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
                            `catch` (throwM . PandocIOError "pipe")
            case ec of
              ExitSuccess -> 1 <$ Lua.pushLazyByteString output
              ExitFailure n -> do
                pushPipeError (PipeError (T.pack command) n output)
                Lua.error)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e String
peekString Text
"string" Text
"command" Text
"path to executable"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. Peeker e String
peekString) Text
"{string,...}" Text
"args"
          Text
"list of arguments"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e ByteString
peekLazyByteString Text
"string" Text
"input"
          Text
"input passed to process via stdin"
    forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"output string, or error triple"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"read"
    ### (\content mformatspec mreaderOptions -> do
            let formatSpec = fromMaybe "markdown" mformatspec
                readerOpts = fromMaybe def mreaderOptions
                readAction = getReader formatSpec >>= \case
                  (TextReader r, es)       ->
                    r readerOpts{readerExtensions = es}
                      (case content of
                         Left bs       -> toSources $ UTF8.toText bs
                         Right sources -> sources)
                  (ByteStringReader r, es) ->
                    case content of
                      Left bs -> r readerOpts{readerExtensions = es}
                                   (BSL.fromStrict bs)
                      Right _ -> liftPandocLua $ Lua.failLua
                                 "Cannot use bytestring reader with Sources"
            try (unPandocLua readAction) >>= \case
              Right pd ->
                -- success, got a Pandoc document
                return pd
              Left  (PandocUnknownReaderError f) ->
                Lua.failLua . T.unpack $ "Unknown reader: " <> f
              Left  (PandocUnsupportedExtensionError e f) ->
                Lua.failLua . T.unpack $
                "Extension " <> e <> " not supported for " <> f
              Left e ->
                throwM e)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (\StackIndex
idx -> (forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Peeker e ByteString
peekByteString StackIndex
idx)
                       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. LuaError e => Peeker e Sources
peekSources StackIndex
idx))
          Text
"string|Sources" Text
"content" Text
"text to parse"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"formatspec" Text
"format and extensions")
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e ReaderOptions
peekReaderOptions Text
"ReaderOptions" Text
"reader_options"
             Text
"reader options")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"Pandoc" Text
"result document"

  , forall e. DocumentedFunction e
sha1

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk_block"
    ### walkElement
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Block
peekBlockFuzzy Text
"Block" Text
"block" Text
"element to traverse"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter Text
"Filter" Text
"lua_filter" Text
"filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Block
pushBlock Text
"Block" Text
"modified Block"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk_inline"
    ### walkElement
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Inline
peekInlineFuzzy Text
"Inline" Text
"inline" Text
"element to traverse"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter Text
"Filter" Text
"lua_filter" Text
"filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Inline
pushInline Text
"Inline" Text
"modified Inline"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"write"
    ### (\doc mformatspec mwriterOpts -> do
            let formatSpec = fromMaybe "html" mformatspec
                writerOpts = fromMaybe def mwriterOpts
            unPandocLua $ getWriter formatSpec >>= \case
              (TextWriter w, es)      -> Right <$>
                w writerOpts{ writerExtensions = es } doc
              (ByteStringWriter w, es) -> Left <$>
                w writerOpts{ writerExtensions = es } doc)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc" Text
"document to convert"
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e. Text -> Text -> Parameter e Text
textParam Text
"formatspec" Text
"format and extensions")
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e WriterOptions
peekWriterOptions Text
"WriterOptions" Text
"writer_options"
              Text
"writer options")
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e. Pusher e ByteString
pushLazyByteString forall e. Pusher e Text
pushText) Text
"string"
          Text
"result document"
  ]
 where
  walkElement :: b -> Filter -> LuaE e b
walkElement b
x Filter
f =
        forall e a.
(LuaError e, Walkable (SpliceList Inline) a) =>
Filter -> a -> LuaE e a
walkInlineSplicing Filter
f b
x
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a.
(LuaError e, Walkable [Inline] a) =>
Filter -> a -> LuaE e a
walkInlinesStraight Filter
f
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a.
(LuaError e, Walkable (SpliceList Block) a) =>
Filter -> a -> LuaE e a
walkBlockSplicing Filter
f
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a.
(LuaError e, Walkable [Block] a) =>
Filter -> a -> LuaE e a
walkBlocksStraight Filter
f

data PipeError = PipeError
  { PipeError -> Text
pipeErrorCommand :: T.Text
  , PipeError -> Int
pipeErrorCode :: Int
  , PipeError -> ByteString
pipeErrorOutput :: BL.ByteString
  }

peekPipeError :: LuaError e => StackIndex -> LuaE e PipeError
peekPipeError :: forall e. LuaError e => StackIndex -> LuaE e PipeError
peekPipeError StackIndex
idx =
  Text -> Int -> ByteString -> PipeError
PipeError
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"command"    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. Int -> LuaE e ()
Lua.pop Int
1)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"error_code" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. Int -> LuaE e ()
Lua.pop Int
1)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
idx Name
"output"     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek (-StackIndex
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. Int -> LuaE e ()
Lua.pop Int
1)

pushPipeError :: LuaError e => Pusher e PipeError
pushPipeError :: forall e. LuaError e => Pusher e PipeError
pushPipeError PipeError
pipeErr = do
  forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [ (Name
"command"    , forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeError -> Text
pipeErrorCommand)
              , (Name
"error_code" , forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeError -> Int
pipeErrorCode)
              , (Name
"output"     , forall e. Pusher e ByteString
pushLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeError -> ByteString
pipeErrorOutput)
              ] PipeError
pipeErr
  forall e. LuaError e => LuaE e ()
pushPipeErrorMetaTable
  forall e. StackIndex -> LuaE e ()
Lua.setmetatable (CInt -> StackIndex
nth CInt
2)
    where
      pushPipeErrorMetaTable :: LuaError e => LuaE e ()
      pushPipeErrorMetaTable :: forall e. LuaError e => LuaE e ()
pushPipeErrorMetaTable = do
        Bool
v <- forall e. Name -> LuaE e Bool
Lua.newmetatable Name
"pandoc pipe error"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v forall a b. (a -> b) -> a -> b
$ do
          forall e. Name -> LuaE e ()
pushName Name
"__tostring"
          forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall e. LuaError e => LuaE e NumResults
pipeErrorMessage
          forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)

      pipeErrorMessage :: LuaError e => LuaE e NumResults
      pipeErrorMessage :: forall e. LuaError e => LuaE e NumResults
pipeErrorMessage = do
        (PipeError Text
cmd Int
errorCode ByteString
output) <- forall e. LuaError e => StackIndex -> LuaE e PipeError
peekPipeError (CInt -> StackIndex
nthBottom CInt
1)
        forall e. Pusher e ByteString
pushByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSL.concat forall a b. (a -> b) -> a -> b
$
          [ String -> ByteString
BSL.pack String
"Error running "
          , String -> ByteString
BSL.pack forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cmd
          , String -> ByteString
BSL.pack String
" (error code "
          , String -> ByteString
BSL.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
errorCode
          , String -> ByteString
BSL.pack String
"): "
          , if ByteString
output forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then String -> ByteString
BSL.pack String
"<no output>" else ByteString
output
          ]
        forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)