content: {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  {- |
     Module      : Text.Pandoc.Lua.PandocLua
     Copyright   : © 2020-2024 Albert Krewinkel
     License     : GPL-2.0-or-later
     Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>
  
  PandocMonad instance which allows execution of Lua operations and which
  uses Lua to handle state.
  -}
  module Text.Pandoc.Lua.PandocLua
    ( PandocLua (..)
    , liftPandocLua
    ) where
  
  import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
  import Control.Monad.Except (MonadError (catchError, throwError))
  import Control.Monad.IO.Class (MonadIO)
  import HsLua as Lua
  import Text.Pandoc.Class (PandocMonad (..))
  import Text.Pandoc.Error (PandocError (..))
  import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState, pushCommonState)
  import Text.Pandoc.Lua.Marshal.PandocError (peekPandocError, pushPandocError)
  
  import qualified Control.Monad.Catch as Catch
  import qualified Data.Text as T
  import qualified Text.Pandoc.Class.IO as IO
  
  -- | Type providing access to both, pandoc and Lua operations.
  newtype PandocLua a = PandocLua { unPandocLua :: LuaE PandocError a }
    deriving
      ( Applicative
      , Functor
      , Monad
      , MonadCatch
      , MonadIO
      , MonadMask
      , MonadThrow
      )
  
  -- | Lift a @'Lua'@ operation into the @'PandocLua'@ type.
  liftPandocLua :: LuaE PandocError a -> PandocLua a
  liftPandocLua = PandocLua
  
  instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where
    partialApply _narg = liftLua . unPandocLua
  
  instance Pushable a => Exposable PandocError (PandocLua a) where
    partialApply _narg x = 1 <$ (liftLua (unPandocLua x >>= Lua.push))
  
  instance MonadError PandocError PandocLua where
    catchError = Catch.catch
    throwError = Catch.throwM
  
  instance PandocMonad PandocLua where
    lookupEnv = IO.lookupEnv
    getCurrentTime = IO.getCurrentTime
    getCurrentTimeZone = IO.getCurrentTimeZone
    newStdGen = IO.newStdGen
    newUniqueHash = IO.newUniqueHash
  
    openURL = IO.openURL
  
    readFileLazy = IO.readFileLazy
    readFileStrict = IO.readFileStrict
    readStdinStrict = IO.readStdinStrict
  
    glob = IO.glob
    fileExists = IO.fileExists
    getDataFileName = IO.getDataFileName
    getModificationTime = IO.getModificationTime
  
    getCommonState = PandocLua $ do
      Lua.getfield registryindex "PANDOC_STATE"
      forcePeek $ peekCommonState Lua.top `lastly` pop 1
    putCommonState cst = PandocLua $ do
      pushCommonState cst
      Lua.setfield registryindex "PANDOC_STATE"
  
    logOutput = IO.logOutput
  
  -- | Retrieve a @'PandocError'@ from the Lua stack.
  popPandocError :: LuaE PandocError PandocError
  popPandocError = do
    errResult <- runPeek $ peekPandocError top `lastly` pop 1
    case resultToEither errResult of
      Right x  -> return x
      Left err -> return $ PandocLuaError (T.pack err)
  
  -- | Conversions between Lua errors and 'PandocError' exceptions.
  instance LuaError PandocError where
    popException = popPandocError
    pushException = pushPandocError
    luaException = PandocLuaError . T.pack
  