{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{- |
   Module      : Text.Pandoc.Readers.Custom
   Copyright   : Copyright (C) 2021 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 Data.Text (Text)
import HsLua as Lua hiding (Operation (Div), render)
import HsLua.Class.Peekable (PeekError)
import Control.Monad.IO.Class (MonadIO)
import Text.Pandoc.Definition
import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.Util (dofileWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Sources (ToSources(..), sourcesToText)

-- | 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
sources = do
  let input :: Text
input = Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ s -> Sources
forall a. ToSources a => a -> Sources
toSources s
sources
  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. LuaError e => FilePath -> LuaE e Status
dofileWithTraceback 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
    Text -> ReaderOptions -> LuaE PandocError Pandoc
forall e. PeekError e => Text -> ReaderOptions -> LuaE e Pandoc
parseCustom Text
input ReaderOptions
opts
  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

parseCustom :: forall e. PeekError e
            => Text
            -> ReaderOptions
            -> LuaE e Pandoc
parseCustom :: Text -> ReaderOptions -> LuaE e Pandoc
parseCustom = Name -> Text -> ReaderOptions -> LuaE e Pandoc
forall e a. Invokable e a => Name -> a
invoke @e Name
"Reader"