{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.PandocLua
   Copyright   : © 2020-2023 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

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 { forall a. PandocLua a -> LuaE PandocError a
unPandocLua :: LuaE PandocError a }
  deriving
    ( Functor PandocLua
forall a. a -> PandocLua a
forall a b. PandocLua a -> PandocLua b -> PandocLua a
forall a b. PandocLua a -> PandocLua b -> PandocLua b
forall a b. PandocLua (a -> b) -> PandocLua a -> PandocLua b
forall a b c.
(a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PandocLua a -> PandocLua b -> PandocLua a
$c<* :: forall a b. PandocLua a -> PandocLua b -> PandocLua a
*> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
$c*> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
liftA2 :: forall a b c.
(a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
<*> :: forall a b. PandocLua (a -> b) -> PandocLua a -> PandocLua b
$c<*> :: forall a b. PandocLua (a -> b) -> PandocLua a -> PandocLua b
pure :: forall a. a -> PandocLua a
$cpure :: forall a. a -> PandocLua a
Applicative
    , forall a b. a -> PandocLua b -> PandocLua a
forall a b. (a -> b) -> PandocLua a -> PandocLua b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PandocLua b -> PandocLua a
$c<$ :: forall a b. a -> PandocLua b -> PandocLua a
fmap :: forall a b. (a -> b) -> PandocLua a -> PandocLua b
$cfmap :: forall a b. (a -> b) -> PandocLua a -> PandocLua b
Functor
    , Applicative PandocLua
forall a. a -> PandocLua a
forall a b. PandocLua a -> PandocLua b -> PandocLua b
forall a b. PandocLua a -> (a -> PandocLua b) -> PandocLua b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PandocLua a
$creturn :: forall a. a -> PandocLua a
>> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
$c>> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
>>= :: forall a b. PandocLua a -> (a -> PandocLua b) -> PandocLua b
$c>>= :: forall a b. PandocLua a -> (a -> PandocLua b) -> PandocLua b
Monad
    , MonadThrow PandocLua
forall e a.
Exception e =>
PandocLua a -> (e -> PandocLua a) -> PandocLua a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
PandocLua a -> (e -> PandocLua a) -> PandocLua a
$ccatch :: forall e a.
Exception e =>
PandocLua a -> (e -> PandocLua a) -> PandocLua a
MonadCatch
    , Monad PandocLua
forall a. IO a -> PandocLua a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> PandocLua a
$cliftIO :: forall a. IO a -> PandocLua a
MonadIO
    , MonadCatch PandocLua
forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
forall a b c.
PandocLua a
-> (a -> ExitCase b -> PandocLua c)
-> (a -> PandocLua b)
-> PandocLua (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
PandocLua a
-> (a -> ExitCase b -> PandocLua c)
-> (a -> PandocLua b)
-> PandocLua (b, c)
$cgeneralBracket :: forall a b c.
PandocLua a
-> (a -> ExitCase b -> PandocLua c)
-> (a -> PandocLua b)
-> PandocLua (b, c)
uninterruptibleMask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
$cuninterruptibleMask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
mask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
$cmask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
MonadMask
    , Monad PandocLua
forall e a. Exception e => e -> PandocLua a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> PandocLua a
$cthrowM :: forall e a. Exception e => e -> PandocLua a
MonadThrow
    )

-- | Lift a @'Lua'@ operation into the @'PandocLua'@ type.
liftPandocLua :: LuaE PandocError a -> PandocLua a
liftPandocLua :: forall a. LuaE PandocError a -> PandocLua a
liftPandocLua = forall a. LuaE PandocError a -> PandocLua a
PandocLua

instance {-# OVERLAPPING #-} Exposable PandocError (PandocLua NumResults) where
  partialApply :: StackIndex -> PandocLua NumResults -> Peek PandocError NumResults
partialApply StackIndex
_narg = forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocLua a -> LuaE PandocError a
unPandocLua

instance Pushable a => Exposable PandocError (PandocLua a) where
  partialApply :: StackIndex -> PandocLua a -> Peek PandocError NumResults
partialApply StackIndex
_narg PandocLua a
x = NumResults
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall e a. LuaE e a -> Peek e a
liftLua (forall a. PandocLua a -> LuaE PandocError a
unPandocLua PandocLua a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a e. (Pushable a, LuaError e) => a -> LuaE e ()
Lua.push))

instance MonadError PandocError PandocLua where
  catchError :: forall a.
PandocLua a -> (PandocError -> PandocLua a) -> PandocLua a
catchError = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Catch.catch
  throwError :: forall a. PandocError -> PandocLua a
throwError = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM

instance PandocMonad PandocLua where
  lookupEnv :: Text -> PandocLua (Maybe Text)
lookupEnv = forall (m :: * -> *). MonadIO m => Text -> m (Maybe Text)
IO.lookupEnv
  getCurrentTime :: PandocLua UTCTime
getCurrentTime = forall (m :: * -> *). MonadIO m => m UTCTime
IO.getCurrentTime
  getCurrentTimeZone :: PandocLua TimeZone
getCurrentTimeZone = forall (m :: * -> *). MonadIO m => m TimeZone
IO.getCurrentTimeZone
  newStdGen :: PandocLua StdGen
newStdGen = forall (m :: * -> *). MonadIO m => m StdGen
IO.newStdGen
  newUniqueHash :: PandocLua Int
newUniqueHash = forall (m :: * -> *). MonadIO m => m Int
IO.newUniqueHash

  openURL :: Text -> PandocLua (ByteString, Maybe Text)
openURL = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Text -> m (ByteString, Maybe Text)
IO.openURL

  readFileLazy :: FilePath -> PandocLua ByteString
readFileLazy = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m ByteString
IO.readFileLazy
  readFileStrict :: FilePath -> PandocLua ByteString
readFileStrict = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m ByteString
IO.readFileStrict
  readStdinStrict :: PandocLua ByteString
readStdinStrict = forall (m :: * -> *). (PandocMonad m, MonadIO m) => m ByteString
IO.readStdinStrict

  glob :: FilePath -> PandocLua [FilePath]
glob = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m [FilePath]
IO.glob
  fileExists :: FilePath -> PandocLua Bool
fileExists = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m Bool
IO.fileExists
  getDataFileName :: FilePath -> PandocLua FilePath
getDataFileName = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m FilePath
IO.getDataFileName
  getModificationTime :: FilePath -> PandocLua UTCTime
getModificationTime = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> m UTCTime
IO.getModificationTime

  getCommonState :: PandocLua CommonState
getCommonState = forall a. LuaE PandocError a -> PandocLua a
PandocLua forall a b. (a -> b) -> a -> b
$ do
    forall e. LuaError e => Name -> LuaE e Type
Lua.getglobal Name
"PANDOC_STATE"
    forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e CommonState
peekCommonState StackIndex
Lua.top
  putCommonState :: CommonState -> PandocLua ()
putCommonState CommonState
cst = forall a. LuaE PandocError a -> PandocLua a
PandocLua forall a b. (a -> b) -> a -> b
$ do
    forall e. LuaError e => Pusher e CommonState
pushCommonState CommonState
cst
    forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_STATE"

  logOutput :: LogMessage -> PandocLua ()
logOutput = forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
LogMessage -> m ()
IO.logOutput

-- | Retrieve a @'PandocError'@ from the Lua stack.
popPandocError :: LuaE PandocError PandocError
popPandocError :: LuaE PandocError PandocError
popPandocError = do
  Result PandocError
errResult <- forall e a. Peek e a -> LuaE e (Result a)
runPeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e PandocError
peekPandocError StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
  case forall a. Result a -> Either FilePath a
resultToEither Result PandocError
errResult of
    Right PandocError
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return PandocError
x
    Left FilePath
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (FilePath -> Text
T.pack FilePath
err)

-- | Conversions between Lua errors and 'PandocError' exceptions.
instance LuaError PandocError where
  popException :: LuaE PandocError PandocError
popException = LuaE PandocError PandocError
popPandocError
  pushException :: PandocError -> LuaE PandocError ()
pushException = forall e. LuaError e => Pusher e PandocError
pushPandocError
  luaException :: FilePath -> PandocError
luaException = Text -> PandocError
PandocLuaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack