{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Readers.Custom
   Copyright   : Copyright (C) 2021-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Supports custom parsers written in Lua which produce a Pandoc AST.
-}
module Text.Pandoc.Readers.Custom ( readCustom ) where
import Control.Exception
import Control.Monad (when)
import HsLua as Lua hiding (Operation (Div))
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Definition
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.PandocLua
import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
import Text.Pandoc.Options
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
import qualified Data.Text as T

-- | Convert custom markup to Pandoc.
readCustom :: (PandocMonad m, MonadIO m, ToSources s)
            => FilePath -> ReaderOptions -> s -> m Pandoc
readCustom :: FilePath -> ReaderOptions -> s -> m Pandoc
readCustom FilePath
luaFile ReaderOptions
opts s
srcs = do
  let globals :: [Global]
globals = [ FilePath -> Global
PANDOC_SCRIPT_FILE FilePath
luaFile ]
  Either PandocError Pandoc
res <- LuaE PandocError Pandoc -> m (Either PandocError Pandoc)
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
LuaE PandocError a -> m (Either PandocError a)
runLua (LuaE PandocError Pandoc -> m (Either PandocError Pandoc))
-> LuaE PandocError Pandoc -> m (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ do
    [Global] -> LuaE PandocError ()
setGlobals [Global]
globals
    Status
stat <- FilePath -> LuaE PandocError Status
forall e. FilePath -> LuaE e Status
dofileTrace FilePath
luaFile
    -- check for error in lua script (later we'll change the return type
    -- to handle this more gracefully):
    Bool -> LuaE PandocError () -> LuaE PandocError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
stat Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Lua.OK)
      LuaE PandocError ()
forall e a. LuaError e => LuaE e a
Lua.throwErrorAsException
    LuaE PandocError Pandoc
parseCustom
  case Either PandocError Pandoc
res of
    Left PandocError
msg -> PandocError -> m Pandoc
forall a e. Exception e => e -> a
throw PandocError
msg
    Right Pandoc
doc -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
 where
  parseCustom :: LuaE PandocError Pandoc
parseCustom = do
    let input :: Sources
input = s -> Sources
forall a. ToSources a => a -> Sources
toSources s
srcs
    Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"Reader"
    Sources -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push Sources
input
    ReaderOptions -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ReaderOptions
opts
    NumArgs -> NumResults -> LuaE PandocError Status
forall e. NumArgs -> NumResults -> LuaE e Status
pcallTrace NumArgs
2 NumResults
1 LuaE PandocError Status
-> (Status -> LuaE PandocError Pandoc) -> LuaE PandocError Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Status
OK -> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Pandoc -> LuaE PandocError Pandoc)
-> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
      Status
ErrRun -> do
        -- Caught a runtime error. Check if parsing might work if we
        -- pass a string instead of a Sources list, then retry.
        Peek PandocError Text -> LuaE PandocError (Result Text)
forall e a. Peek e a -> LuaE e (Result a)
runPeek (Peeker PandocError Text
forall e. Peeker e Text
peekText StackIndex
top) LuaE PandocError (Result Text)
-> (Result Text -> LuaE PandocError Pandoc)
-> LuaE PandocError Pandoc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Failure {} ->
            -- not a string error object. Bail!
            LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException
          Success Text
errmsg -> do
            if Text
"string expected, got pandoc Sources" Text -> Text -> Bool
`T.isInfixOf` Text
errmsg
              then do
                Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
                ()
_ <- PandocLua () -> LuaE PandocError ()
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua () -> LuaE PandocError ())
-> PandocLua () -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ do
                  LogMessage -> PandocLua ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocLua ()) -> LogMessage -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
Deprecated Text
"old Reader function signature" (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$
                    [Text] -> Text
T.unlines
                    [ Text
"Reader functions should accept a sources list; "
                    , Text
"functions expecting `string` input are deprecated. "
                    , Text
"Use `tostring` to convert the first argument to a "
                    , Text
"string."
                    ]
                Name -> LuaE PandocError Type
forall e. LuaError e => Name -> LuaE e Type
getglobal Name
"Reader"
                Text -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push (Text -> LuaE PandocError ()) -> Text -> LuaE PandocError ()
forall a b. (a -> b) -> a -> b
$ Sources -> Text
sourcesToText Sources
input  -- push sources as string
                ReaderOptions -> LuaE PandocError ()
forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
push ReaderOptions
opts
                NumArgs -> NumResults -> LuaE PandocError ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
2 NumResults
1
                Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError Pandoc -> LuaE PandocError Pandoc)
-> Peek PandocError Pandoc -> LuaE PandocError Pandoc
forall a b. (a -> b) -> a -> b
$ Peeker PandocError Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc StackIndex
top
              else
                -- nothing we can do here
                LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException
      Status
_ ->  -- not a runtime error, we won't be able to recover from that
        LuaE PandocError Pandoc
forall e a. LuaError e => LuaE e a
throwErrorAsException