{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{- |
Copyright               : © 2021-2023 Albert Krewinkel
SPDX-License-Identifier : MIT
Maintainer              : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Marshaling/unmarshaling functions of 'MetaValue' elements.
-}
module Text.Pandoc.Lua.Marshal.MetaValue
  ( peekMetaValue
  , pushMetaValue
  , metaValueConstructors
  ) where

import Control.Applicative ((<|>), optional)
import Control.Monad ((<$!>))
import HsLua
import Text.Pandoc.Lua.Marshal.Block
  ( peekBlock, peekBlocks, peekBlocksFuzzy, pushBlocks )
import Text.Pandoc.Lua.Marshal.Inline
  ( peekInline, peekInlines, peekInlinesFuzzy, pushInlines )
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Definition (MetaValue (..))
import qualified Data.Text as T

-- | Push a 'MetaValue' element to the top of the Lua stack.
pushMetaValue :: LuaError e => Pusher e MetaValue
pushMetaValue :: forall e. LuaError e => Pusher e MetaValue
pushMetaValue = \case
  MetaBlocks [Block]
blcks  -> forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
blcks
  MetaBool Bool
bool     -> forall e. Pusher e Bool
pushBool Bool
bool
  MetaInlines [Inline]
inlns -> forall e. LuaError e => Pusher e [Inline]
pushInlines [Inline]
inlns
  MetaList [MetaValue]
metalist -> forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList forall e. LuaError e => Pusher e MetaValue
pushMetaValue [MetaValue]
metalist
  MetaMap Map Text MetaValue
metamap   -> 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 => Pusher e MetaValue
pushMetaValue Map Text MetaValue
metamap
  MetaString Text
t      -> forall e. Pusher e Text
pushText Text
t

-- | Retrieves the value at the given stack index as 'MetaValue'.
peekMetaValue :: forall e. LuaError e => Peeker e MetaValue
peekMetaValue :: forall e. LuaError e => Peeker e MetaValue
peekMetaValue = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaValue" forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
  -- Get the contents of an AST element.

  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
TypeBoolean -> Bool -> MetaValue
MetaBool forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Bool
peekBool StackIndex
idx

    Type
TypeString  -> Text -> MetaValue
MetaString forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. Peeker e Text
peekText StackIndex
idx

    Type
TypeNumber  -> Text -> MetaValue
MetaString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Bool
isinteger StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
False -> forall a. Show a => a -> String
show forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat @Double StackIndex
idx
          Bool
True  -> forall a. Show a => a -> String
show forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a e. (Integral a, Read a) => Peeker e a
peekIntegral @Prelude.Integer StackIndex
idx)

    Type
TypeUserdata -> -- Allow singleton Inline or Block elements
      ([Inline] -> MetaValue
MetaInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e Inline
peekInline StackIndex
idx) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ([Block] -> MetaValue
MetaBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e Block
peekBlock StackIndex
idx)

    Type
TypeTable   -> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall {e}. StackIndex -> Peek e Name
getName StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Name
"Inlines" -> [Inline] -> MetaValue
MetaInlines forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy StackIndex
idx
      Just Name
"Blocks"  -> [Block] -> MetaValue
MetaBlocks  forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy StackIndex
idx
      Just Name
"List"    -> [MetaValue] -> MetaValue
MetaList 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 MetaValue
peekMetaValue StackIndex
idx
      Maybe Name
_ -> do
        -- no meta value tag given, try to guess.
        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
rawlen StackIndex
idx
        if Int
len forall a. Ord a => a -> a -> Bool
<= Int
0
          then Map Text MetaValue -> MetaValue
MetaMap 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 MetaValue
peekMetaValue StackIndex
idx
          else  ([Inline] -> MetaValue
MetaInlines forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Inline]
peekInlines StackIndex
idx)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Block] -> MetaValue
MetaBlocks forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e. LuaError e => Peeker e [Block]
peekBlocks StackIndex
idx)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([MetaValue] -> MetaValue
MetaList 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 MetaValue
peekMetaValue StackIndex
idx)

    Type
_ -> forall a e. ByteString -> Peek e a
failPeek ByteString
"could not get meta value"

 where
  getName :: StackIndex -> Peek e Name
getName StackIndex
idx = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> Name -> LuaE e Type
getmetafield StackIndex
idx Name
"__name") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeNil -> forall a e. ByteString -> Peek e a
failPeek ByteString
"no name"
    Type
_ -> forall {e}. StackIndex -> Peek e Name
peekName StackIndex
idx forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1


-- | Constructor functions for 'MetaValue' elements.
metaValueConstructors :: LuaError e => [DocumentedFunction e]
metaValueConstructors :: forall e. LuaError e => [DocumentedFunction e]
metaValueConstructors =
  [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaBlocks"
    ### liftPure MetaBlocks
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"Blocks" Text
"content" Text
"block content"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"Blocks" Text
"list of Block elements"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaBool"
    ### liftPure MetaBool
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Bool
boolParam Text
"bool" Text
"true or false"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"boolean" Text
"input, unchanged"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaInlines"
    ### liftPure MetaInlines
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Inline]
peekInlinesFuzzy Text
"Inlines" Text
"inlines" Text
"inline elements"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"Inlines" Text
"list of Inline elements"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaList"
    ### liftPure MetaList
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e MetaValue
peekMetaValue) Text
"MetaValue|{MetaValue,...}"
          Text
"values" Text
"value, or list of values"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"List" Text
"list of meta values"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaMap"
    ### liftPure MetaMap
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (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 MetaValue
peekMetaValue) Text
"table" Text
"map"
          Text
"string-indexed table"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"table" Text
"map of meta values"

  , forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"MetaString"
    ### liftPure MetaString
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e. Text -> Text -> Parameter e Text
textParam Text
"s" Text
"string value"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e MetaValue
pushMetaValue Text
"string" Text
"unchanged input"
  ]