{-# LANGUAGE DeriveDataTypeable #-}
module Text.Pandoc.Lua.Global
( Global (..)
, setGlobals
) where
import Data.Data (Data)
import Foreign.Lua (Lua, Peekable, Pushable)
import Foreign.Lua.Userdata ( ensureUserdataMetatable, pushAnyWithMetatable
, metatableName)
import Paths_pandoc (version)
import Text.Pandoc.Class.CommonState (CommonState)
import Text.Pandoc.Definition (Pandoc (Pandoc), pandocTypesVersion)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Util (addFunction)
import Text.Pandoc.Options (ReaderOptions)
import qualified Data.Text as Text
import qualified Foreign.Lua as Lua
data Global =
FORMAT Text.Text
| PANDOC_API_VERSION
| PANDOC_DOCUMENT Pandoc
| PANDOC_READER_OPTIONS ReaderOptions
| PANDOC_SCRIPT_FILE FilePath
| PANDOC_STATE CommonState
| PANDOC_VERSION
setGlobals :: [Global] -> Lua ()
setGlobals :: [Global] -> Lua ()
setGlobals = (Global -> Lua ()) -> [Global] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Global -> Lua ()
setGlobal
setGlobal :: Global -> Lua ()
setGlobal :: Global -> Lua ()
setGlobal global :: Global
global = case Global
global of
FORMAT format :: Text
format -> do
Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
format
String -> Lua ()
Lua.setglobal "FORMAT"
PANDOC_API_VERSION -> do
Version -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Version
pandocTypesVersion
String -> Lua ()
Lua.setglobal "PANDOC_API_VERSION"
PANDOC_DOCUMENT doc :: Pandoc
doc -> do
LazyPandoc -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Pandoc -> LazyPandoc
LazyPandoc Pandoc
doc)
String -> Lua ()
Lua.setglobal "PANDOC_DOCUMENT"
PANDOC_READER_OPTIONS ropts :: ReaderOptions
ropts -> do
ReaderOptions -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ReaderOptions
ropts
String -> Lua ()
Lua.setglobal "PANDOC_READER_OPTIONS"
PANDOC_SCRIPT_FILE filePath :: String
filePath -> do
String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
filePath
String -> Lua ()
Lua.setglobal "PANDOC_SCRIPT_FILE"
PANDOC_STATE commonState :: CommonState
commonState -> do
CommonState -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push CommonState
commonState
String -> Lua ()
Lua.setglobal "PANDOC_STATE"
PANDOC_VERSION -> do
Version -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Version
version
String -> Lua ()
Lua.setglobal "PANDOC_VERSION"
newtype LazyPandoc = LazyPandoc Pandoc
deriving (Typeable LazyPandoc
DataType
Constr
Typeable LazyPandoc =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LazyPandoc -> c LazyPandoc)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LazyPandoc)
-> (LazyPandoc -> Constr)
-> (LazyPandoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LazyPandoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LazyPandoc))
-> ((forall b. Data b => b -> b) -> LazyPandoc -> LazyPandoc)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> LazyPandoc -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> LazyPandoc -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc)
-> Data LazyPandoc
LazyPandoc -> DataType
LazyPandoc -> Constr
(forall b. Data b => b -> b) -> LazyPandoc -> LazyPandoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LazyPandoc -> c LazyPandoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LazyPandoc
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LazyPandoc -> u
forall u. (forall d. Data d => d -> u) -> LazyPandoc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LazyPandoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LazyPandoc -> c LazyPandoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LazyPandoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LazyPandoc)
$cLazyPandoc :: Constr
$tLazyPandoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
gmapMp :: (forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
gmapM :: (forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LazyPandoc -> m LazyPandoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> LazyPandoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LazyPandoc -> u
gmapQ :: (forall d. Data d => d -> u) -> LazyPandoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LazyPandoc -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LazyPandoc -> r
gmapT :: (forall b. Data b => b -> b) -> LazyPandoc -> LazyPandoc
$cgmapT :: (forall b. Data b => b -> b) -> LazyPandoc -> LazyPandoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LazyPandoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LazyPandoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LazyPandoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LazyPandoc)
dataTypeOf :: LazyPandoc -> DataType
$cdataTypeOf :: LazyPandoc -> DataType
toConstr :: LazyPandoc -> Constr
$ctoConstr :: LazyPandoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LazyPandoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LazyPandoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LazyPandoc -> c LazyPandoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LazyPandoc -> c LazyPandoc
$cp1Data :: Typeable LazyPandoc
Data)
instance Pushable LazyPandoc where
push :: LazyPandoc -> Lua ()
push lazyDoc :: LazyPandoc
lazyDoc = Lua () -> LazyPandoc -> Lua ()
forall a. Lua () -> a -> Lua ()
pushAnyWithMetatable Lua ()
pushPandocMetatable LazyPandoc
lazyDoc
where
pushPandocMetatable :: Lua ()
pushPandocMetatable = String -> Lua () -> Lua ()
ensureUserdataMetatable (LazyPandoc -> String
forall a. Data a => a -> String
metatableName LazyPandoc
lazyDoc) (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$
String -> (LazyPandoc -> String -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
addFunction "__index" LazyPandoc -> String -> Lua NumResults
indexLazyPandoc
instance Peekable LazyPandoc where
peek :: StackIndex -> Lua LazyPandoc
peek = StackIndex -> Lua LazyPandoc
forall a. Data a => StackIndex -> Lua a
Lua.peekAny
indexLazyPandoc :: LazyPandoc -> String -> Lua Lua.NumResults
indexLazyPandoc :: LazyPandoc -> String -> Lua NumResults
indexLazyPandoc (LazyPandoc (Pandoc meta :: Meta
meta blks :: [Block]
blks)) field :: String
field = 1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
case String
field of
"blocks" -> [Block] -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push [Block]
blks
"meta" -> Meta -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Meta
meta
_ -> Lua ()
Lua.pushnil