{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Pandoc
   Copyright   : Copyright © 2017-2020 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
  ) 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.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
                                  loadScriptFromDataDir)
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

-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
-- loaded.
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  FilePath -> PandocLua ()
loadScriptFromDataDir FilePath
"pandoc.lua"
  FilePath
-> (Text -> Optional Text -> PandocLua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => FilePath -> a -> PandocLua ()
addFunction FilePath
"read" Text -> Optional Text -> PandocLua NumResults
readDoc
  FilePath
-> (FilePath -> [FilePath] -> ByteString -> PandocLua NumResults)
-> PandocLua ()
forall a. ToHaskellFunction a => FilePath -> a -> PandocLua ()
addFunction FilePath
"pipe" FilePath -> [FilePath] -> ByteString -> PandocLua NumResults
pipeFn
  FilePath -> (Block -> LuaFilter -> PandocLua Block) -> PandocLua ()
forall a. ToHaskellFunction a => FilePath -> a -> PandocLua ()
addFunction FilePath
"walk_block" Block -> LuaFilter -> PandocLua Block
walkBlock
  FilePath
-> (Inline -> LuaFilter -> PandocLua Inline) -> PandocLua ()
forall a. ToHaskellFunction a => FilePath -> a -> PandocLua ()
addFunction FilePath
"walk_inline" Inline -> LuaFilter -> PandocLua Inline
walkInline
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1

walkElement :: (Walkable (SingletonsList Inline) a,
                Walkable (SingletonsList Block) a)
            => a -> LuaFilter -> PandocLua a
walkElement :: a -> LuaFilter -> PandocLua a
walkElement a
x LuaFilter
f = Lua a -> PandocLua a
forall a. Lua a -> PandocLua a
liftPandocLua (Lua a -> PandocLua a) -> Lua a -> PandocLua a
forall a b. (a -> b) -> a -> b
$ 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 -> PandocLua Inline
walkInline :: Inline -> LuaFilter -> PandocLua Inline
walkInline = Inline -> LuaFilter -> PandocLua Inline
forall a.
(Walkable (SingletonsList Inline) a,
 Walkable (SingletonsList Block) a) =>
a -> LuaFilter -> PandocLua a
walkElement

walkBlock :: Block -> LuaFilter -> PandocLua Block
walkBlock :: Block -> LuaFilter -> PandocLua Block
walkBlock = Block -> LuaFilter -> PandocLua Block
forall a.
(Walkable (SingletonsList Inline) a,
 Walkable (SingletonsList Block) a) =>
a -> LuaFilter -> PandocLua a
walkElement

readDoc :: T.Text -> Optional T.Text -> PandocLua NumResults
readDoc :: Text -> Optional Text -> PandocLua NumResults
readDoc Text
content Optional Text
formatSpecOrNil = Lua NumResults -> PandocLua NumResults
forall a. Lua a -> PandocLua a
liftPandocLua (Lua NumResults -> PandocLua NumResults)
-> Lua NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ 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 -- success, push Pandoc
    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

-- | Pipes input through a command.
pipeFn :: String
       -> [String]
       -> BL.ByteString
       -> PandocLua NumResults
pipeFn :: FilePath -> [FilePath] -> ByteString -> PandocLua NumResults
pipeFn FilePath
command [FilePath]
args ByteString
input = Lua NumResults -> PandocLua NumResults
forall a. Lua a -> PandocLua a
liftPandocLua (Lua NumResults -> PandocLua NumResults)
-> Lua NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ 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
          ]