{-# 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.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 :: 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
                      "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 -- success, push Pandoc
    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

-- | Pipes input through a command.
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
          ]