{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.PandocLua
   Copyright   : Copyright © 2020-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

PandocMonad instance which allows execution of Lua operations and which
uses Lua to handle state.
-}
module Text.Pandoc.Lua.PandocLua
  ( PandocLua (..)
  , runPandocLua
  , 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 (PandocMonad (..))
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Marshal.CommonState (peekCommonState)

import qualified Control.Monad.Catch as Catch
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

-- | Evaluate a @'PandocLua'@ computation, running all contained Lua
-- operations..
runPandocLua :: (PandocMonad m, MonadIO m) => PandocLua a -> m a
runPandocLua :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
PandocLua a -> m a
runPandocLua PandocLua a
pLua = do
  CommonState
origState <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  [Global]
globals <- forall (m :: * -> *). PandocMonad m => m [Global]
defaultGlobals
  (a
result, CommonState
newState) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaE e a -> IO a
Lua.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocLua a -> LuaE PandocError a
unPandocLua forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
origState
    forall a. LuaE PandocError a -> PandocLua a
liftPandocLua forall a b. (a -> b) -> a -> b
$ [Global] -> LuaE PandocError ()
setGlobals [Global]
globals
    a
r <- PandocLua a
pLua
    CommonState
c <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, CommonState
c)
  forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
newState
  forall (m :: * -> *) a. Monad m => a -> m a
return a
result

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))

-- | Global variables which should always be set.
defaultGlobals :: PandocMonad m => m [Global]
defaultGlobals :: forall (m :: * -> *). PandocMonad m => m [Global]
defaultGlobals = do
  CommonState
commonState <- forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  forall (m :: * -> *) a. Monad m => a -> m a
return
    [ Global
PANDOC_API_VERSION
    , CommonState -> Global
PANDOC_STATE CommonState
commonState
    , Global
PANDOC_VERSION
    ]

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 = forall a. LuaE PandocError a -> PandocLua a
PandocLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Global] -> LuaE PandocError ()
setGlobals forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Global
PANDOC_STATE

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