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