{-# 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
( PandocLua (..)
, runPandocLua
, liftPandocLua
, addFunction
, loadDefaultModule
) where
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Except (MonadError (catchError, throwError))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Foreign.Lua (Lua (..), NumResults, Pushable, ToHaskellFunction)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDefaultDataFile)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.ErrorConversion (errorConversion)
import qualified Control.Monad.Catch as Catch
import qualified Data.Text as T
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Class.IO as IO
newtype PandocLua a = PandocLua { PandocLua a -> Lua a
unPandocLua :: Lua a }
deriving
( Functor PandocLua
a -> PandocLua a
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
PandocLua a -> PandocLua b -> PandocLua b
PandocLua a -> PandocLua b -> PandocLua a
PandocLua (a -> b) -> PandocLua a -> PandocLua b
(a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
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
<* :: PandocLua a -> PandocLua b -> PandocLua a
$c<* :: forall a b. PandocLua a -> PandocLua b -> PandocLua a
*> :: PandocLua a -> PandocLua b -> PandocLua b
$c*> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
liftA2 :: (a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocLua a -> PandocLua b -> PandocLua c
<*> :: PandocLua (a -> b) -> PandocLua a -> PandocLua b
$c<*> :: forall a b. PandocLua (a -> b) -> PandocLua a -> PandocLua b
pure :: a -> PandocLua a
$cpure :: forall a. a -> PandocLua a
$cp1Applicative :: Functor PandocLua
Applicative
, a -> PandocLua b -> PandocLua a
(a -> b) -> PandocLua a -> PandocLua b
(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
<$ :: a -> PandocLua b -> PandocLua a
$c<$ :: forall a b. a -> PandocLua b -> PandocLua a
fmap :: (a -> b) -> PandocLua a -> PandocLua b
$cfmap :: forall a b. (a -> b) -> PandocLua a -> PandocLua b
Functor
, Applicative PandocLua
a -> PandocLua a
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
PandocLua a -> (a -> PandocLua b) -> PandocLua b
PandocLua a -> PandocLua b -> PandocLua b
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 :: a -> PandocLua a
$creturn :: forall a. a -> PandocLua a
>> :: PandocLua a -> PandocLua b -> PandocLua b
$c>> :: forall a b. PandocLua a -> PandocLua b -> PandocLua b
>>= :: PandocLua a -> (a -> PandocLua b) -> PandocLua b
$c>>= :: forall a b. PandocLua a -> (a -> PandocLua b) -> PandocLua b
$cp1Monad :: Applicative PandocLua
Monad
, MonadThrow PandocLua
MonadThrow PandocLua
-> (forall e a.
Exception e =>
PandocLua a -> (e -> PandocLua a) -> PandocLua a)
-> MonadCatch PandocLua
PandocLua a -> (e -> PandocLua a) -> PandocLua a
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 :: PandocLua a -> (e -> PandocLua a) -> PandocLua a
$ccatch :: forall e a.
Exception e =>
PandocLua a -> (e -> PandocLua a) -> PandocLua a
$cp1MonadCatch :: MonadThrow PandocLua
MonadCatch
, Monad PandocLua
Monad PandocLua
-> (forall a. IO a -> PandocLua a) -> MonadIO PandocLua
IO a -> PandocLua a
forall a. IO a -> PandocLua a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PandocLua a
$cliftIO :: forall a. IO a -> PandocLua a
$cp1MonadIO :: Monad PandocLua
MonadIO
, MonadCatch PandocLua
MonadCatch PandocLua
-> (forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b)
-> (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))
-> MonadMask PandocLua
PandocLua a
-> (a -> ExitCase b -> PandocLua c)
-> (a -> PandocLua b)
-> PandocLua (b, c)
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
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 :: 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 a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
$cuninterruptibleMask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
mask :: ((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
$cmask :: forall b.
((forall a. PandocLua a -> PandocLua a) -> PandocLua b)
-> PandocLua b
$cp1MonadMask :: MonadCatch PandocLua
MonadMask
, Monad PandocLua
e -> PandocLua a
Monad PandocLua
-> (forall e a. Exception e => e -> PandocLua a)
-> MonadThrow PandocLua
forall e a. Exception e => e -> PandocLua a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> PandocLua a
$cthrowM :: forall e a. Exception e => e -> PandocLua a
$cp1MonadThrow :: Monad PandocLua
MonadThrow
)
liftPandocLua :: Lua a -> PandocLua a
liftPandocLua :: Lua a -> PandocLua a
liftPandocLua = Lua a -> PandocLua a
forall a. Lua a -> PandocLua a
PandocLua
runPandocLua :: PandocLua a -> PandocIO a
runPandocLua :: PandocLua a -> PandocIO a
runPandocLua PandocLua a
pLua = do
CommonState
origState <- PandocIO CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
[Global]
globals <- PandocIO [Global]
defaultGlobals
(a
result, CommonState
newState) <- IO (a, CommonState) -> PandocIO (a, CommonState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, CommonState) -> PandocIO (a, CommonState))
-> (PandocLua (a, CommonState) -> IO (a, CommonState))
-> PandocLua (a, CommonState)
-> PandocIO (a, CommonState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorConversion -> Lua (a, CommonState) -> IO (a, CommonState)
forall a. ErrorConversion -> Lua a -> IO a
Lua.run' ErrorConversion
errorConversion (Lua (a, CommonState) -> IO (a, CommonState))
-> (PandocLua (a, CommonState) -> Lua (a, CommonState))
-> PandocLua (a, CommonState)
-> IO (a, CommonState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua (a, CommonState) -> Lua (a, CommonState)
forall a. PandocLua a -> Lua a
unPandocLua (PandocLua (a, CommonState) -> PandocIO (a, CommonState))
-> PandocLua (a, CommonState) -> PandocIO (a, CommonState)
forall a b. (a -> b) -> a -> b
$ do
CommonState -> PandocLua ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
origState
Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ [Global] -> Lua ()
setGlobals [Global]
globals
a
r <- PandocLua a
pLua
CommonState
c <- PandocLua CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
(a, CommonState) -> PandocLua (a, CommonState)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, CommonState
c)
CommonState -> PandocIO ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState CommonState
newState
a -> PandocIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
instance {-# OVERLAPPING #-} ToHaskellFunction (PandocLua NumResults) where
toHsFun :: StackIndex -> PandocLua NumResults -> Lua NumResults
toHsFun StackIndex
_narg = PandocLua NumResults -> Lua NumResults
forall a. PandocLua a -> Lua a
unPandocLua
instance Pushable a => ToHaskellFunction (PandocLua a) where
toHsFun :: StackIndex -> PandocLua a -> Lua NumResults
toHsFun StackIndex
_narg PandocLua a
x = NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (PandocLua a -> Lua a
forall a. PandocLua a -> Lua a
unPandocLua PandocLua a
x Lua a -> (a -> Lua ()) -> Lua ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push)
addFunction :: ToHaskellFunction a => String -> a -> PandocLua ()
addFunction :: String -> a -> PandocLua ()
addFunction String
name a
fn = Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua (Lua () -> PandocLua ()) -> Lua () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
name
a -> Lua ()
forall a. ToHaskellFunction a => a -> Lua ()
Lua.pushHaskellFunction a
fn
StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
loadDefaultModule :: String -> PandocLua NumResults
loadDefaultModule :: String -> PandocLua NumResults
loadDefaultModule String
name = do
ByteString
script <- String -> PandocLua ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDefaultDataFile (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".lua")
Status
status <- Lua Status -> PandocLua Status
forall a. Lua a -> PandocLua a
liftPandocLua (Lua Status -> PandocLua Status) -> Lua Status -> PandocLua Status
forall a b. (a -> b) -> a -> b
$ ByteString -> Lua Status
Lua.dostring ByteString
script
if Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Lua.OK
then NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults
1 :: NumResults)
else do
String
msg <- Lua String -> PandocLua String
forall a. Lua a -> PandocLua a
liftPandocLua Lua String
forall a. Peekable a => Lua a
Lua.popValue
let err :: String
err = String
"Error while loading `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
PandocError -> PandocLua NumResults
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocLua NumResults)
-> PandocError -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (String -> Text
T.pack String
err)
defaultGlobals :: PandocIO [Global]
defaultGlobals :: PandocIO [Global]
defaultGlobals = do
CommonState
commonState <- PandocIO CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
[Global] -> PandocIO [Global]
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 :: PandocLua a -> (PandocError -> PandocLua a) -> PandocLua a
catchError = PandocLua a -> (PandocError -> PandocLua a) -> PandocLua a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Catch.catch
throwError :: PandocError -> PandocLua a
throwError = PandocError -> PandocLua a
forall (m :: * -> *) e a. (MonadThrow m, 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 :: String -> PandocLua ByteString
readFileLazy = String -> PandocLua ByteString
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m ByteString
IO.readFileLazy
readFileStrict :: String -> PandocLua ByteString
readFileStrict = String -> PandocLua ByteString
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m ByteString
IO.readFileStrict
glob :: String -> PandocLua [String]
glob = String -> PandocLua [String]
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m [String]
IO.glob
fileExists :: String -> PandocLua Bool
fileExists = String -> PandocLua Bool
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m Bool
IO.fileExists
getDataFileName :: String -> PandocLua String
getDataFileName = String -> PandocLua String
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m String
IO.getDataFileName
getModificationTime :: String -> PandocLua UTCTime
getModificationTime = String -> PandocLua UTCTime
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m UTCTime
IO.getModificationTime
getCommonState :: PandocLua CommonState
getCommonState = Lua CommonState -> PandocLua CommonState
forall a. Lua a -> PandocLua a
PandocLua (Lua CommonState -> PandocLua CommonState)
-> Lua CommonState -> PandocLua CommonState
forall a b. (a -> b) -> a -> b
$ do
String -> Lua ()
Lua.getglobal String
"PANDOC_STATE"
StackIndex -> Lua CommonState
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
Lua.stackTop
putCommonState :: CommonState -> PandocLua ()
putCommonState = Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
PandocLua (Lua () -> PandocLua ())
-> (CommonState -> Lua ()) -> CommonState -> PandocLua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Global] -> Lua ()
setGlobals ([Global] -> Lua ())
-> (CommonState -> [Global]) -> CommonState -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Global -> [Global] -> [Global]
forall a. a -> [a] -> [a]
:[]) (Global -> [Global])
-> (CommonState -> Global) -> CommonState -> [Global]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> Global
PANDOC_STATE
logOutput :: LogMessage -> PandocLua ()
logOutput = LogMessage -> PandocLua ()
forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
LogMessage -> m ()
IO.logOutput