1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE OverloadedStrings #-} 3{- | 4 Module : Text.Pandoc.Lua.Module.Pandoc 5 Copyright : Copyright © 2017-2021 Albert Krewinkel 6 License : GNU GPL, version 2 or above 7 8 Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> 9 Stability : alpha 10 11Pandoc module for lua. 12-} 13module Text.Pandoc.Lua.Module.Pandoc 14 ( pushModule 15 ) where 16 17import Prelude hiding (read) 18import Control.Monad (when) 19import Control.Monad.Except (throwError) 20import Data.Default (Default (..)) 21import Data.Maybe (fromMaybe) 22import Foreign.Lua (Lua, NumResults, Optional, Peekable, Pushable) 23import System.Exit (ExitCode (..)) 24import Text.Pandoc.Class.PandocIO (runIO) 25import Text.Pandoc.Definition (Block, Inline) 26import Text.Pandoc.Lua.Filter (LuaFilter, SingletonsList (..), walkInlines, 27 walkInlineLists, walkBlocks, walkBlockLists) 28import Text.Pandoc.Lua.Marshaling () 29import Text.Pandoc.Lua.Marshaling.List (List (..)) 30import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua, 31 loadDefaultModule) 32import Text.Pandoc.Walk (Walkable) 33import Text.Pandoc.Options (ReaderOptions (readerExtensions)) 34import Text.Pandoc.Process (pipeProcess) 35import Text.Pandoc.Readers (Reader (..), getReader) 36 37import qualified Data.ByteString.Lazy as BL 38import qualified Data.ByteString.Lazy.Char8 as BSL 39import qualified Data.Text as T 40import qualified Foreign.Lua as Lua 41import qualified Text.Pandoc.Lua.Util as LuaUtil 42import Text.Pandoc.Error 43 44-- | Push the "pandoc" package to the Lua stack. Requires the `List` 45-- module to be loadable. 46pushModule :: PandocLua NumResults 47pushModule = do 48 loadDefaultModule "pandoc" 49 addFunction "read" read 50 addFunction "pipe" pipe 51 addFunction "walk_block" walk_block 52 addFunction "walk_inline" walk_inline 53 return 1 54 55walkElement :: (Walkable (SingletonsList Inline) a, 56 Walkable (SingletonsList Block) a, 57 Walkable (List Inline) a, 58 Walkable (List Block) a) 59 => a -> LuaFilter -> PandocLua a 60walkElement x f = liftPandocLua $ 61 walkInlines f x >>= walkInlineLists f >>= walkBlocks f >>= walkBlockLists f 62 63walk_inline :: Inline -> LuaFilter -> PandocLua Inline 64walk_inline = walkElement 65 66walk_block :: Block -> LuaFilter -> PandocLua Block 67walk_block = walkElement 68 69read :: T.Text -> Optional T.Text -> PandocLua NumResults 70read content formatSpecOrNil = liftPandocLua $ do 71 let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil) 72 res <- Lua.liftIO . runIO $ 73 getReader formatSpec >>= \(rdr,es) -> 74 case rdr of 75 TextReader r -> 76 r def{ readerExtensions = es } content 77 _ -> throwError $ PandocSomeError 78 "Only textual formats are supported" 79 case res of 80 Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc 81 Left (PandocUnknownReaderError f) -> Lua.raiseError $ 82 "Unknown reader: " <> f 83 Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ 84 "Extension " <> e <> " not supported for " <> f 85 Left e -> Lua.raiseError $ show e 86 87-- | Pipes input through a command. 88pipe :: String -- ^ path to executable 89 -> [String] -- ^ list of arguments 90 -> BL.ByteString -- ^ input passed to process via stdin 91 -> PandocLua NumResults 92pipe command args input = liftPandocLua $ do 93 (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input 94 case ec of 95 ExitSuccess -> 1 <$ Lua.push output 96 ExitFailure n -> Lua.raiseError (PipeError (T.pack command) n output) 97 98data PipeError = PipeError 99 { pipeErrorCommand :: T.Text 100 , pipeErrorCode :: Int 101 , pipeErrorOutput :: BL.ByteString 102 } 103 104instance Peekable PipeError where 105 peek idx = 106 PipeError 107 <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1) 108 <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1) 109 <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1) 110 111instance Pushable PipeError where 112 push pipeErr = do 113 Lua.newtable 114 LuaUtil.addField "command" (pipeErrorCommand pipeErr) 115 LuaUtil.addField "error_code" (pipeErrorCode pipeErr) 116 LuaUtil.addField "output" (pipeErrorOutput pipeErr) 117 pushPipeErrorMetaTable 118 Lua.setmetatable (-2) 119 where 120 pushPipeErrorMetaTable :: Lua () 121 pushPipeErrorMetaTable = do 122 v <- Lua.newmetatable "pandoc pipe error" 123 when v $ LuaUtil.addFunction "__tostring" pipeErrorMessage 124 125 pipeErrorMessage :: PipeError -> Lua BL.ByteString 126 pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat 127 [ BSL.pack "Error running " 128 , BSL.pack $ T.unpack cmd 129 , BSL.pack " (error code " 130 , BSL.pack $ show errorCode 131 , BSL.pack "): " 132 , if output == mempty then BSL.pack "<no output>" else output 133 ] 134