{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.Context
   Copyright   : © 2012-2023 John MacFarlane
                 © 2017-2023 Albert Krewinkel
   License     : GNU GPL, version 2 or above

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

Marshaling instance for doctemplates Context and its components.
-}
module Text.Pandoc.Lua.Marshal.Context
  ( peekContext
  , pushContext
  ) where

import Control.Monad (when, (<$!>))
import Data.Text (Text)
import HsLua as Lua
import HsLua.Module.DocLayout (peekDoc, pushDoc)
import Text.DocTemplates (Context(..), Val(..))

instance Pushable (Context Text) where
  push :: forall e. LuaError e => Context Text -> LuaE e ()
push = Pusher e (Context Text)
forall e. LuaError e => Context Text -> LuaE e ()
pushContext

instance Pushable (Val Text) where
  push :: forall e. LuaError e => Val Text -> LuaE e ()
push = Pusher e (Val Text)
forall e. LuaError e => Val Text -> LuaE e ()
pushVal

-- | Retrieves a template context from the Lua stack.
peekContext :: LuaError e => Peeker e (Context Text)
peekContext :: forall e. LuaError e => Peeker e (Context Text)
peekContext StackIndex
idx = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Peek e (Map Text (Val Text)) -> Peek e (Context Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Text
-> Peeker e (Val Text) -> Peeker e (Map Text (Val Text))
forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e Text
forall e. Peeker e Text
peekText Peeker e (Val Text)
forall e. LuaError e => Peeker e (Val Text)
peekVal StackIndex
idx

-- | Pushes a template context to the Lua stack.
pushContext :: LuaError e => Pusher e (Context Text)
pushContext :: forall e. LuaError e => Context Text -> LuaE e ()
pushContext Context Text
ctx = do
  Pusher e Text
-> Pusher e (Val Text) -> Pusher e (Map Text (Val Text))
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap Pusher e Text
forall e. Pusher e Text
pushText Pusher e (Val Text)
forall e. LuaError e => Val Text -> LuaE e ()
pushVal Pusher e (Map Text (Val Text)) -> Pusher e (Map Text (Val Text))
forall a b. (a -> b) -> a -> b
$ Context Text -> Map Text (Val Text)
forall a. Context a -> Map Text (Val a)
unContext Context Text
ctx
  Bool
created <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
Lua.newmetatable Name
"pandoc Context"
  Bool -> LuaE e () -> LuaE e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created (LuaE e () -> LuaE e ()) -> LuaE e () -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"__concat"
    HaskellFunction e -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction (HaskellFunction e -> LuaE e ()) -> HaskellFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
      Context Text
c1 <- Peek e (Context Text) -> LuaE e (Context Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e (Context Text) -> LuaE e (Context Text))
-> Peek e (Context Text) -> LuaE e (Context Text)
forall a b. (a -> b) -> a -> b
$ Peeker e (Context Text)
forall e. LuaError e => Peeker e (Context Text)
peekContext (CInt -> StackIndex
nthBottom CInt
1)
      Context Text
c2 <- Peek e (Context Text) -> LuaE e (Context Text)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e (Context Text) -> LuaE e (Context Text))
-> Peek e (Context Text) -> LuaE e (Context Text)
forall a b. (a -> b) -> a -> b
$ Peeker e (Context Text)
forall e. LuaError e => Peeker e (Context Text)
peekContext (CInt -> StackIndex
nthBottom CInt
2)
      Pusher e (Context Text)
forall e. LuaError e => Context Text -> LuaE e ()
pushContext (Context Text
c1 Context Text -> Context Text -> Context Text
forall a. Semigroup a => a -> a -> a
<> Context Text
c2)
      NumResults -> HaskellFunction e
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)

pushVal :: LuaError e => Pusher e (Val Text)
pushVal :: forall e. LuaError e => Val Text -> LuaE e ()
pushVal = \case
  Val Text
NullVal     -> LuaE e ()
forall e. LuaE e ()
Lua.pushnil
  BoolVal Bool
b   -> Pusher e Bool
forall e. Pusher e Bool
Lua.pushBool Bool
b
  MapVal Context Text
ctx  -> Pusher e (Context Text)
forall e. LuaError e => Context Text -> LuaE e ()
pushContext Context Text
ctx
  ListVal [Val Text]
xs  -> (Val Text -> LuaE e ()) -> [Val Text] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Val Text -> LuaE e ()
forall e. LuaError e => Val Text -> LuaE e ()
pushVal [Val Text]
xs
  SimpleVal Doc Text
d -> Pusher e (Doc Text)
forall e. LuaError e => Pusher e (Doc Text)
pushDoc Doc Text
d

peekVal :: LuaError e => Peeker e (Val Text)
peekVal :: forall e. LuaError e => Peeker e (Val Text)
peekVal StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (Val Text)) -> Peek e (Val Text)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil      -> Val Text -> Peek e (Val Text)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val Text
forall a. Val a
NullVal
  Type
TypeBoolean  -> Bool -> Val Text
forall a. Bool -> Val a
BoolVal (Bool -> Val Text) -> Peek e Bool -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Bool
forall e. Peeker e Bool
peekBool StackIndex
idx
  Type
TypeNumber   -> Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Peek e (Doc Text) -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
TypeString   -> Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Peek e (Doc Text) -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
TypeTable    -> do
    Int
len <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Int -> Peek e Int) -> LuaE e Int -> Peek e Int
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
Lua.rawlen StackIndex
idx
    if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      then Context Text -> Val Text
forall a. Context a -> Val a
MapVal (Context Text -> Val Text)
-> Peek e (Context Text) -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Context Text)
forall e. LuaError e => Peeker e (Context Text)
peekContext StackIndex
idx
      else [Val Text] -> Val Text
forall a. [Val a] -> Val a
ListVal ([Val Text] -> Val Text) -> Peek e [Val Text] -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Val Text) -> Peeker e [Val Text]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e (Val Text)
forall e. LuaError e => Peeker e (Val Text)
peekVal StackIndex
idx
  Type
TypeUserdata -> Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Peek e (Doc Text) -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e (Doc Text)
forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
_ -> ByteString -> Peek e (Val Text)
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e (Val Text))
-> Peek e ByteString -> Peek e (Val Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Doc, string, boolean, table, or nil" StackIndex
idx