{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.Pandoc
( pushModule
) where
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 System.Exit (ExitCode (..))
import Text.Pandoc.Class.PandocIO (runIO)
import Text.Pandoc.Definition (Block, Inline)
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter, SingletonsList (..))
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Walk (Walkable)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
import Text.Pandoc.Readers (Reader (..), getReader)
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
pushModule :: Maybe FilePath -> Lua NumResults
pushModule :: Maybe FilePath -> Lua NumResults
pushModule Maybe FilePath
datadir = do
Maybe FilePath -> FilePath -> Lua ()
LuaUtil.loadScriptFromDataDir Maybe FilePath
datadir FilePath
"pandoc.lua"
FilePath -> (Text -> Optional Text -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction FilePath
"read" Text -> Optional Text -> Lua NumResults
readDoc
FilePath
-> (FilePath -> [FilePath] -> ByteString -> Lua NumResults)
-> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction FilePath
"pipe" FilePath -> [FilePath] -> ByteString -> Lua NumResults
pipeFn
FilePath -> (Block -> LuaFilter -> Lua Block) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction FilePath
"walk_block" Block -> LuaFilter -> Lua Block
walkBlock
FilePath -> (Inline -> LuaFilter -> Lua Inline) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction FilePath
"walk_inline" Inline -> LuaFilter -> Lua Inline
walkInline
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
walkElement :: (Walkable (SingletonsList Inline) a,
Walkable (SingletonsList Block) a)
=> a -> LuaFilter -> Lua a
walkElement :: a -> LuaFilter -> Lua a
walkElement a
x LuaFilter
f = LuaFilter -> a -> Lua a
forall a.
Walkable (SingletonsList Inline) a =>
LuaFilter -> a -> Lua a
walkInlines LuaFilter
f a
x Lua a -> (a -> Lua a) -> Lua a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LuaFilter -> a -> Lua a
forall a.
Walkable (SingletonsList Block) a =>
LuaFilter -> a -> Lua a
walkBlocks LuaFilter
f
walkInline :: Inline -> LuaFilter -> Lua Inline
walkInline :: Inline -> LuaFilter -> Lua Inline
walkInline = Inline -> LuaFilter -> Lua Inline
forall a.
(Walkable (SingletonsList Inline) a,
Walkable (SingletonsList Block) a) =>
a -> LuaFilter -> Lua a
walkElement
walkBlock :: Block -> LuaFilter -> Lua Block
walkBlock :: Block -> LuaFilter -> Lua Block
walkBlock = Block -> LuaFilter -> Lua Block
forall a.
(Walkable (SingletonsList Inline) a,
Walkable (SingletonsList Block) a) =>
a -> LuaFilter -> Lua a
walkElement
readDoc :: T.Text -> Optional T.Text -> Lua NumResults
readDoc :: Text -> Optional Text -> Lua NumResults
readDoc Text
content Optional Text
formatSpecOrNil = do
let formatSpec :: Text
formatSpec = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"markdown" (Optional Text -> Maybe Text
forall a. Optional a -> Maybe a
Lua.fromOptional Optional Text
formatSpecOrNil)
Either PandocError Pandoc
res <- IO (Either PandocError Pandoc) -> Lua (Either PandocError Pandoc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO (Either PandocError Pandoc) -> Lua (Either PandocError Pandoc))
-> (PandocIO Pandoc -> IO (Either PandocError Pandoc))
-> PandocIO Pandoc
-> Lua (Either PandocError Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO Pandoc -> Lua (Either PandocError Pandoc))
-> PandocIO Pandoc -> Lua (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$
Text -> PandocIO (Reader PandocIO, Extensions)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (Reader m, Extensions)
getReader Text
formatSpec PandocIO (Reader PandocIO, Extensions)
-> ((Reader PandocIO, Extensions) -> PandocIO Pandoc)
-> PandocIO Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Reader PandocIO
rdr,Extensions
es) ->
case Reader PandocIO
rdr of
TextReader ReaderOptions -> Text -> PandocIO Pandoc
r ->
ReaderOptions -> Text -> PandocIO Pandoc
r ReaderOptions
forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Extensions
es } Text
content
Reader PandocIO
_ -> PandocError -> PandocIO Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO Pandoc) -> PandocError -> PandocIO Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError
Text
"Only textual formats are supported"
case Either PandocError Pandoc
res of
Right Pandoc
pd -> (NumResults
1 :: NumResults) NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Pandoc -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Pandoc
pd
Left (PandocUnknownReaderError Text
f) -> Text -> Lua NumResults
forall a. Pushable a => a -> Lua NumResults
Lua.raiseError (Text -> Lua NumResults) -> Text -> Lua NumResults
forall a b. (a -> b) -> a -> b
$
Text
"Unknown reader: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
Left (PandocUnsupportedExtensionError Text
e Text
f) -> Text -> Lua NumResults
forall a. Pushable a => a -> Lua NumResults
Lua.raiseError (Text -> Lua NumResults) -> Text -> Lua NumResults
forall a b. (a -> b) -> a -> b
$
Text
"Extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not supported for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
Left PandocError
e -> FilePath -> Lua NumResults
forall a. Pushable a => a -> Lua NumResults
Lua.raiseError (FilePath -> Lua NumResults) -> FilePath -> Lua NumResults
forall a b. (a -> b) -> a -> b
$ PandocError -> FilePath
forall a. Show a => a -> FilePath
show PandocError
e
pipeFn :: String
-> [String]
-> BL.ByteString
-> Lua NumResults
pipeFn :: FilePath -> [FilePath] -> ByteString -> Lua NumResults
pipeFn FilePath
command [FilePath]
args ByteString
input = do
(ExitCode
ec, ByteString
output) <- IO (ExitCode, ByteString) -> Lua (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO (ExitCode, ByteString) -> Lua (ExitCode, ByteString))
-> IO (ExitCode, ByteString) -> Lua (ExitCode, ByteString)
forall a b. (a -> b) -> a -> b
$ Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString)
pipeProcess Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing FilePath
command [FilePath]
args ByteString
input
case ExitCode
ec of
ExitCode
ExitSuccess -> NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ByteString
output
ExitFailure Int
n -> PipeError -> Lua NumResults
forall a. Pushable a => a -> Lua NumResults
Lua.raiseError (Text -> Int -> ByteString -> PipeError
PipeError (FilePath -> Text
T.pack FilePath
command) Int
n ByteString
output)
data PipeError = PipeError
{ PipeError -> Text
pipeErrorCommand :: T.Text
, PipeError -> Int
pipeErrorCode :: Int
, PipeError -> ByteString
pipeErrorOutput :: BL.ByteString
}
instance Peekable PipeError where
peek :: StackIndex -> Lua PipeError
peek StackIndex
idx =
Text -> Int -> ByteString -> PipeError
PipeError
(Text -> Int -> ByteString -> PipeError)
-> Lua Text -> Lua (Int -> ByteString -> PipeError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"command" Lua () -> Lua Text -> Lua Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua Text
forall a. Peekable a => StackIndex -> Lua a
Lua.peek (-StackIndex
1) Lua Text -> Lua () -> Lua Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop StackIndex
1)
Lua (Int -> ByteString -> PipeError)
-> Lua Int -> Lua (ByteString -> PipeError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"error_code" Lua () -> Lua Int -> Lua Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua Int
forall a. Peekable a => StackIndex -> Lua a
Lua.peek (-StackIndex
1) Lua Int -> Lua () -> Lua Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop StackIndex
1)
Lua (ByteString -> PipeError) -> Lua ByteString -> Lua PipeError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StackIndex -> FilePath -> Lua ()
Lua.getfield StackIndex
idx FilePath
"output" Lua () -> Lua ByteString -> Lua ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ByteString
forall a. Peekable a => StackIndex -> Lua a
Lua.peek (-StackIndex
1) Lua ByteString -> Lua () -> Lua ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop StackIndex
1)
instance Pushable PipeError where
push :: PipeError -> Lua ()
push PipeError
pipeErr = do
Lua ()
Lua.newtable
FilePath -> Text -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField FilePath
"command" (PipeError -> Text
pipeErrorCommand PipeError
pipeErr)
FilePath -> Int -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField FilePath
"error_code" (PipeError -> Int
pipeErrorCode PipeError
pipeErr)
FilePath -> ByteString -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField FilePath
"output" (PipeError -> ByteString
pipeErrorOutput PipeError
pipeErr)
Lua ()
pushPipeErrorMetaTable
StackIndex -> Lua ()
Lua.setmetatable (-StackIndex
2)
where
pushPipeErrorMetaTable :: Lua ()
pushPipeErrorMetaTable :: Lua ()
pushPipeErrorMetaTable = do
Bool
v <- FilePath -> Lua Bool
Lua.newmetatable FilePath
"pandoc pipe error"
Bool -> Lua () -> Lua ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
v (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (PipeError -> Lua ByteString) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction FilePath
"__tostring" PipeError -> Lua ByteString
pipeErrorMessage
pipeErrorMessage :: PipeError -> Lua BL.ByteString
pipeErrorMessage :: PipeError -> Lua ByteString
pipeErrorMessage (PipeError Text
cmd Int
errorCode ByteString
output) = ByteString -> Lua ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Lua ByteString) -> ByteString -> Lua ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ FilePath -> ByteString
BSL.pack FilePath
"Error running "
, FilePath -> ByteString
BSL.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
cmd
, FilePath -> ByteString
BSL.pack FilePath
" (error code "
, FilePath -> ByteString
BSL.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
errorCode
, FilePath -> ByteString
BSL.pack FilePath
"): "
, if ByteString
output ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty then FilePath -> ByteString
BSL.pack FilePath
"<no output>" else ByteString
output
]