{-# 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 = forall e. LuaError e => Context Text -> LuaE e ()
pushContext

instance Pushable (Val Text) where
  push :: forall e. LuaError e => Val Text -> LuaE e ()
push = 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 = forall a. Map Text (Val a) -> Context a
Context forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap forall e. Peeker e Text
peekText 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
  forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap forall e. Pusher e Text
pushText forall e. LuaError e => Val Text -> LuaE e ()
pushVal forall a b. (a -> b) -> a -> b
$ forall a. Context a -> Map Text (Val a)
unContext Context Text
ctx
  Bool
created <- forall e. Name -> LuaE e Bool
Lua.newmetatable Name
"pandoc Context"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created forall a b. (a -> b) -> a -> b
$ do
    forall e. Name -> LuaE e ()
pushName Name
"__concat"
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$ do
      Context Text
c1 <- 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 (Context Text)
peekContext (CInt -> StackIndex
nthBottom CInt
1)
      Context Text
c2 <- 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 (Context Text)
peekContext (CInt -> StackIndex
nthBottom CInt
2)
      forall e. LuaError e => Context Text -> LuaE e ()
pushContext (Context Text
c1 forall a. Semigroup a => a -> a -> a
<> Context Text
c2)
      forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  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     -> forall e. LuaE e ()
Lua.pushnil
  BoolVal Bool
b   -> forall e. Pusher e Bool
Lua.pushBool Bool
b
  MapVal Context Text
ctx  -> forall e. LuaError e => Context Text -> LuaE e ()
pushContext Context Text
ctx
  ListVal [Val Text]
xs  -> forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Val Text -> LuaE e ()
pushVal [Val Text]
xs
  SimpleVal Doc Text
d -> 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Val a
NullVal
  Type
TypeBoolean  -> forall a. Bool -> Val a
BoolVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Bool
peekBool StackIndex
idx
  Type
TypeNumber   -> forall a. Doc a -> Val a
SimpleVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
TypeString   -> forall a. Doc a -> Val a
SimpleVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
TypeTable    -> do
    Int
len <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e Int
Lua.rawlen StackIndex
idx
    if Int
len forall a. Ord a => a -> a -> Bool
<= Int
0
      then forall a. Context a -> Val a
MapVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e (Context Text)
peekContext StackIndex
idx
      else forall a. [Val a] -> Val a
ListVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e (Val Text)
peekVal StackIndex
idx
  Type
TypeUserdata -> forall a. Doc a -> Val a
SimpleVal forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e (Doc Text)
peekDoc StackIndex
idx
  Type
_ -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
       forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Doc, string, boolean, table, or nil" StackIndex
idx