{-# LANGUAGE DeriveDataTypeable #-}
{- |
   Module      : Text.Pandoc.Lua
   Copyright   : Copyright © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

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

Pandoc's Lua globals.
-}
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

-- | Permissible global Lua variables.
data Global =
    FORMAT Text.Text
  | PANDOC_API_VERSION
  | PANDOC_DOCUMENT Pandoc
  | PANDOC_READER_OPTIONS ReaderOptions
  | PANDOC_SCRIPT_FILE FilePath
  | PANDOC_STATE CommonState
  | PANDOC_VERSION
  -- Cannot derive instance of Data because of CommonState

-- | Set all given globals.
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 = case Global
global of
  -- This could be simplified if Global was an instance of Data.
  FORMAT Text
format -> do
    Text -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Text
format
    String -> Lua ()
Lua.setglobal String
"FORMAT"
  Global
PANDOC_API_VERSION -> do
    Version -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Version
pandocTypesVersion
    String -> Lua ()
Lua.setglobal String
"PANDOC_API_VERSION"
  PANDOC_DOCUMENT Pandoc
doc -> do
    LazyPandoc -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Pandoc -> LazyPandoc
LazyPandoc Pandoc
doc)
    String -> Lua ()
Lua.setglobal String
"PANDOC_DOCUMENT"
  PANDOC_READER_OPTIONS ReaderOptions
ropts -> do
    ReaderOptions -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push ReaderOptions
ropts
    String -> Lua ()
Lua.setglobal String
"PANDOC_READER_OPTIONS"
  PANDOC_SCRIPT_FILE String
filePath -> do
    String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
filePath
    String -> Lua ()
Lua.setglobal String
"PANDOC_SCRIPT_FILE"
  PANDOC_STATE CommonState
commonState -> do
    CommonState -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push CommonState
commonState
    String -> Lua ()
Lua.setglobal String
"PANDOC_STATE"
  Global
PANDOC_VERSION              -> do
    Version -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Version
version
    String -> Lua ()
Lua.setglobal String
"PANDOC_VERSION"

-- | Readonly and lazy pandoc objects.
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 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 String
"__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 [Block]
blks)) String
field = NumResults
1 NumResults -> Lua () -> Lua NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
  case String
field of
    String
"blocks" -> [Block] -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push [Block]
blks
    String
"meta"   -> Meta -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Meta
meta
    String
_        -> Lua ()
Lua.pushnil