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

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

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

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

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

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

  getCommonState :: PandocLua CommonState
getCommonState = LuaE PandocError CommonState -> PandocLua CommonState
forall a. LuaE PandocError a -> PandocLua a
PandocLua (LuaE PandocError CommonState -> PandocLua CommonState)
-> LuaE PandocError CommonState -> PandocLua CommonState
forall a b. (a -> b) -> a -> b
$ do
    StackIndex -> Name -> LuaE PandocError Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
registryindex Name
"PANDOC_STATE"
    Peek PandocError CommonState -> LuaE PandocError CommonState
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek PandocError CommonState -> LuaE PandocError CommonState)
-> Peek PandocError CommonState -> LuaE PandocError CommonState
forall a b. (a -> b) -> a -> b
$ Peeker PandocError CommonState
forall e. LuaError e => Peeker e CommonState
peekCommonState StackIndex
Lua.top Peek PandocError CommonState
-> LuaE PandocError () -> Peek PandocError CommonState
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
  putCommonState :: CommonState -> PandocLua ()
putCommonState CommonState
cst = LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
PandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
    Pusher PandocError CommonState
forall e. LuaError e => Pusher e CommonState
pushCommonState CommonState
cst
    StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
Lua.pushvalue StackIndex
Lua.top
    StackIndex -> Name -> LuaE PandocError ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
Lua.setfield StackIndex
registryindex Name
"PANDOC_STATE"
    Name -> LuaE PandocError ()
forall e. LuaError e => Name -> LuaE e ()
Lua.setglobal Name
"PANDOC_STATE"

  logOutput :: LogMessage -> PandocLua ()
logOutput = LogMessage -> PandocLua ()
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 <- Peek PandocError PandocError
-> LuaE PandocError (Result PandocError)
forall e a. Peek e a -> LuaE e (Result a)
runPeek (Peek PandocError PandocError
 -> LuaE PandocError (Result PandocError))
-> Peek PandocError PandocError
-> LuaE PandocError (Result PandocError)
forall a b. (a -> b) -> a -> b
$ Peeker PandocError PandocError
forall e. LuaError e => Peeker e PandocError
peekPandocError StackIndex
top Peek PandocError PandocError
-> LuaE PandocError () -> Peek PandocError PandocError
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE PandocError ()
forall e. Int -> LuaE e ()
pop Int
1
  case Result PandocError -> Either FilePath PandocError
forall a. Result a -> Either FilePath a
resultToEither Result PandocError
errResult of
    Right PandocError
x  -> PandocError -> LuaE PandocError PandocError
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return PandocError
x
    Left FilePath
err -> PandocError -> LuaE PandocError PandocError
forall a. a -> LuaE PandocError a
forall (m :: * -> *) a. Monad m => a -> m a
return (PandocError -> LuaE PandocError PandocError)
-> PandocError -> LuaE PandocError PandocError
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 = PandocError -> LuaE PandocError ()
forall e. LuaError e => Pusher e PandocError
pushPandocError
  luaException :: FilePath -> PandocError
luaException = Text -> PandocError
PandocLuaError (Text -> PandocError)
-> (FilePath -> Text) -> FilePath -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack