{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Lua.Module.Pandoc
( pushModule
) where
import Prelude
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 (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 datadir :: Maybe FilePath
datadir = do
Maybe FilePath -> FilePath -> Lua ()
LuaUtil.loadScriptFromDataDir Maybe FilePath
datadir "pandoc.lua"
FilePath -> (Text -> Optional Text -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction "read" Text -> Optional Text -> Lua NumResults
readDoc
FilePath
-> (FilePath -> [FilePath] -> ByteString -> Lua NumResults)
-> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction "pipe" FilePath -> [FilePath] -> ByteString -> Lua NumResults
pipeFn
FilePath -> (Block -> LuaFilter -> Lua Block) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction "walk_block" Block -> LuaFilter -> Lua Block
walkBlock
FilePath -> (Inline -> LuaFilter -> Lua Inline) -> Lua ()
forall a. ToHaskellFunction a => FilePath -> a -> Lua ()
LuaUtil.addFunction "walk_inline" Inline -> LuaFilter -> Lua Inline
walkInline
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 1
walkElement :: (Walkable (SingletonsList Inline) a,
Walkable (SingletonsList Block) a)
=> a -> LuaFilter -> Lua a
walkElement :: a -> LuaFilter -> Lua a
walkElement x :: a
x f :: 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 content :: Text
content formatSpecOrNil :: Optional Text
formatSpecOrNil = do
let formatSpec :: Text
formatSpec = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "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
>>= \(rdr :: Reader PandocIO
rdr,es :: Extensions
es) ->
case Reader PandocIO
rdr of
TextReader r :: ReaderOptions -> Text -> PandocIO Pandoc
r ->
ReaderOptions -> Text -> PandocIO Pandoc
r ReaderOptions
forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Extensions
es } Text
content
_ -> 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 -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
"Only textual formats are supported"
case Either PandocError Pandoc
res of
Right pd :: Pandoc
pd -> (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 f :: 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
$
"Unknown reader: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
Left (PandocUnsupportedExtensionError e :: Text
e f :: 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
$
"Extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " not supported for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
Left e :: 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 command :: FilePath
command args :: [FilePath]
args input :: ByteString
input = do
(ec :: ExitCode
ec, output :: 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
ExitSuccess -> 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 n :: 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 idx :: 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 "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 (-1) Lua Text -> Lua () -> Lua Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop 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 "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 (-1) Lua Int -> Lua () -> Lua Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop 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 "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 (-1) Lua ByteString -> Lua () -> Lua ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
Lua.pop 1)
instance Pushable PipeError where
push :: PipeError -> Lua ()
push pipeErr :: PipeError
pipeErr = do
Lua ()
Lua.newtable
FilePath -> Text -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField "command" (PipeError -> Text
pipeErrorCommand PipeError
pipeErr)
FilePath -> Int -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField "error_code" (PipeError -> Int
pipeErrorCode PipeError
pipeErr)
FilePath -> ByteString -> Lua ()
forall a. Pushable a => FilePath -> a -> Lua ()
LuaUtil.addField "output" (PipeError -> ByteString
pipeErrorOutput PipeError
pipeErr)
Lua ()
pushPipeErrorMetaTable
StackIndex -> Lua ()
Lua.setmetatable (-2)
where
pushPipeErrorMetaTable :: Lua ()
pushPipeErrorMetaTable :: Lua ()
pushPipeErrorMetaTable = do
Bool
v <- FilePath -> Lua Bool
Lua.newmetatable "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 "__tostring" PipeError -> Lua ByteString
pipeErrorMessage
pipeErrorMessage :: PipeError -> Lua BL.ByteString
pipeErrorMessage :: PipeError -> Lua ByteString
pipeErrorMessage (PipeError cmd :: Text
cmd errorCode :: Int
errorCode output :: 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 "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 " (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 "): "
, 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 "<no output>" else ByteString
output
]