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

Marshaling/unmarshaling functions of 'Pandoc' values.
-}
module Text.Pandoc.Lua.Marshal.Pandoc
  ( -- * Pandoc
    typePandoc
  , peekPandoc
  , pushPandoc
  , mkPandoc
    -- * Meta
  , peekMeta
  , pushMeta
  , mkMeta
    -- * Filtering
  , applyFully
  ) where

import Control.Applicative (optional)
import Control.Monad ((<$!>))
import Data.Aeson (encode)
import Data.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Lua.Marshal.Block (peekBlocksFuzzy, pushBlocks)
import Text.Pandoc.Lua.Marshal.Filter
import Text.Pandoc.Lua.Marshal.MetaValue (peekMetaValue, pushMetaValue)
import Text.Pandoc.Lua.Marshal.Shared (walkBlocksAndInlines)
import Text.Pandoc.Lua.Walk (applyStraight)
import Text.Pandoc.Definition (Pandoc (..), Meta (..), nullMeta)

-- | Pushes a 'Pandoc' value as userdata.
pushPandoc :: LuaError e => Pusher e Pandoc
pushPandoc :: forall e. LuaError e => Pusher e Pandoc
pushPandoc = forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Pandoc
typePandoc

-- | Retrieves a 'Pandoc' document from a userdata value.
peekPandoc :: LuaError e => Peeker e Pandoc
peekPandoc :: forall e. LuaError e => Peeker e Pandoc
peekPandoc = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Pandoc" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Pandoc
typePandoc

-- | Pandoc object type.
typePandoc :: LuaError e => DocumentedType e Pandoc
typePandoc :: forall e. LuaError e => DocumentedType e Pandoc
typePandoc = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Pandoc"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Concat forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
     ### liftPure2 (<>)
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"a" Text
""
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"b" Text
""
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc TypeSpec
"Pandoc" Text
"combined documents"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
     ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Pandoc
peekPandoc) TypeSpec
"doc1" Text
"pandoc" Text
""
     forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. LuaError e => Peeker e Pandoc
peekPandoc) TypeSpec
"doc2" Text
"pandoc" Text
""
     forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e Bool
pushBool TypeSpec
"boolean" Text
"true iff the two values are equal"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"doc" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString TypeSpec
"string" Text
"native Haskell representation"
  , forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation (Name -> Operation
CustomOperation Name
"__tojson") forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure encode
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Pandoc
typePandoc Text
"self" Text
""
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"JSON representation"
  ]
  [ forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"blocks" Text
"list of blocks"
      (forall e. LuaError e => Pusher e [Block]
pushBlocks, \(Pandoc Meta
_ [Block]
blks) -> [Block]
blks)
      (forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy, \(Pandoc Meta
m [Block]
_) [Block]
blks -> Meta -> [Block] -> Pandoc
Pandoc Meta
m [Block]
blks)
  , forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"meta" Text
"document metadata"
      (forall e. LuaError e => Pusher e Meta
pushMeta, \(Pandoc Meta
meta [Block]
_) -> Meta
meta)
      (forall e. LuaError e => Peeker e Meta
peekMeta, \(Pandoc Meta
_ [Block]
blks) Meta
meta -> Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks)

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"clone"
      ### return
      forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"doc" Text
"self"
      forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc TypeSpec
"Pandoc" Text
"cloned Pandoc document"

  , forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk"
    ### flip applyFully
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc TypeSpec
"Pandoc" Text
"self" Text
""
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Filter
peekFilter TypeSpec
"Filter" Text
"lua_filter" Text
"table of filter functions"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc TypeSpec
"Pandoc" Text
"modified element"
  ]

-- | Pushes a 'Meta' value as a string-indexed table.
pushMeta :: LuaError e => Pusher e Meta
pushMeta :: forall e. LuaError e => Pusher e Meta
pushMeta (Meta Map Text MetaValue
mmap) = 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 => Pusher e MetaValue
pushMetaValue Map Text MetaValue
mmap
  Bool
_ <- forall e. Name -> LuaE e Bool
newmetatable Name
"Meta"
  forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)

-- | Retrieves a 'Meta' value from a string-indexed table.
peekMeta :: LuaError e => Peeker e Meta
peekMeta :: forall e. LuaError e => Peeker e Meta
peekMeta StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Meta" forall a b. (a -> b) -> a -> b
$
  Map Text MetaValue -> Meta
Meta 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

-- | Constructor function for 'Pandoc' values.
mkPandoc :: LuaError e => DocumentedFunction e
mkPandoc :: forall e. LuaError e => DocumentedFunction e
mkPandoc = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Pandoc"
  ### liftPure2 (\blocks mMeta -> Pandoc (fromMaybe nullMeta mMeta) blocks)
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy TypeSpec
"Blocks" Text
"blocks" Text
"document contents"
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Meta
peekMeta TypeSpec
"Meta" Text
"meta" Text
"document metadata")
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc TypeSpec
"Pandoc" Text
"new Pandoc document"

-- | Constructor for 'Meta' values.
mkMeta :: LuaError e => DocumentedFunction e
mkMeta :: forall e. LuaError e => DocumentedFunction e
mkMeta = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Meta"
  ### liftPure id
  forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Meta
peekMeta TypeSpec
"table" Text
"meta" Text
"table containing meta information"
  forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Meta
pushMeta TypeSpec
"table" Text
"new Meta table"

-- | Applies a filter function to a Pandoc value.
applyPandocFunction :: LuaError e
                          => Filter
                          -> Pandoc -> LuaE e Pandoc
applyPandocFunction :: forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyPandocFunction = forall e a.
(LuaError e, Data a) =>
Pusher e a -> Peeker e a -> Filter -> a -> LuaE e a
applyStraight forall e. LuaError e => Pusher e Pandoc
pushPandoc forall e. LuaError e => Peeker e Pandoc
peekPandoc

-- | Applies a filter function to a Meta value.
applyMetaFunction :: LuaError e
                        => Filter
                        -> Pandoc -> LuaE e Pandoc
applyMetaFunction :: forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyMetaFunction Filter
filter' (Pandoc Meta
meta [Block]
blocks) = do
  Meta
meta' <- forall e a.
(LuaError e, Data a) =>
Pusher e a -> Peeker e a -> Filter -> a -> LuaE e a
applyStraight forall e. LuaError e => Pusher e Meta
pushMeta forall e. LuaError e => Peeker e Meta
peekMeta Filter
filter' Meta
meta
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
blocks)

-- | Apply all components of a Lua filter.
--
-- These operations are run in order:
--
-- - Inline filter functions are applied to Inline elements, splicing
--   the result back into the list of Inline elements
--
-- - The @Inlines@ function is applied to all lists of Inlines.
--
-- - Block filter functions are applied to Block elements, splicing the
--   result back into the list of Block elements
--
-- - The @Blocks@ function is applied to all lists of Blocks.
--
-- - The @Meta@ function is applied to the 'Meta' part.
--
-- - The @Pandoc@ function is applied to the full 'Pandoc' element.
applyFully :: LuaError e
           => Filter
           -> Pandoc -> LuaE e Pandoc
applyFully :: forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyFully Filter
filter' Pandoc
doc = case Filter -> WalkingOrder
filterWalkingOrder Filter
filter' of
  WalkingOrder
WalkForEachType -> forall e a.
(LuaError e, Walkable (SpliceList Block) a,
 Walkable (SpliceList Inline) a, Walkable [Block] a,
 Walkable [Inline] a, Walkable Topdown a) =>
Filter -> a -> LuaE e a
walkBlocksAndInlines Filter
filter' Pandoc
doc
                 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyMetaFunction Filter
filter'
                 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyPandocFunction Filter
filter'
  WalkingOrder
WalkTopdown     -> forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyPandocFunction Filter
filter' Pandoc
doc
                 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyMetaFunction Filter
filter'
                 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a.
(LuaError e, Walkable (SpliceList Block) a,
 Walkable (SpliceList Inline) a, Walkable [Block] a,
 Walkable [Inline] a, Walkable Topdown a) =>
Filter -> a -> LuaE e a
walkBlocksAndInlines Filter
filter'