    {-# 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
              ]