{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{- |
Copyright               : © 2021-2022 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 :: Pusher e MetaValue
pushMetaValue = \case
  MetaBlocks [Block]
blcks  -> Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks [Block]
blcks
  MetaBool Bool
bool     -> Pusher e Bool
forall e. Pusher e Bool
pushBool Bool
bool
  MetaInlines [Inline]
inlns -> Pusher e [Inline]
forall e. LuaError e => Pusher e [Inline]
pushInlines [Inline]
inlns
  MetaList [MetaValue]
metalist -> Pusher e MetaValue -> Pusher e [MetaValue]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e MetaValue
forall e. LuaError e => Pusher e MetaValue
pushMetaValue [MetaValue]
metalist
  MetaMap Map Text MetaValue
metamap   -> Pusher e Text
-> Pusher e MetaValue -> Pusher e (Map Text MetaValue)
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 MetaValue
forall e. LuaError e => Pusher e MetaValue
pushMetaValue Map Text MetaValue
metamap
  MetaString Text
t      -> Pusher e Text
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 :: Peeker e MetaValue
peekMetaValue = Name -> Peek e MetaValue -> Peek e MetaValue
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"MetaValue" (Peek e MetaValue -> Peek e MetaValue)
-> Peeker e MetaValue -> Peeker e MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> do
  -- Get the contents of an AST element.

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

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

    Type
TypeNumber  -> Text -> MetaValue
MetaString (Text -> MetaValue) -> (String -> Text) -> String -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> MetaValue) -> Peek e String -> Peek e MetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isinteger StackIndex
idx) Peek e Bool -> (Bool -> Peek e String) -> Peek e String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
False -> Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Peek e Double -> Peek e String
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat @Double StackIndex
idx
          Bool
True  -> Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Peek e Integer -> Peek e String
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Integer
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 ([Inline] -> MetaValue)
-> (Inline -> [Inline]) -> Inline -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[]) (Inline -> MetaValue) -> Peek e Inline -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Inline
forall e. LuaError e => Peeker e Inline
peekInline StackIndex
idx) Peek e MetaValue -> Peek e MetaValue -> Peek e MetaValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ([Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> (Block -> [Block]) -> Block -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) (Block -> MetaValue) -> Peek e Block -> Peek e MetaValue
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e Block
forall e. LuaError e => Peeker e Block
peekBlock StackIndex
idx)

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

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

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


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

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

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

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

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

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