{-# 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
    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 fn a itemtype.
LuaError e =>
UDTypeWithList e fn 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 fn a itemtype.
LuaError e =>
UDTypeWithList e fn 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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"a" Text
""
     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 Pandoc
peekPandoc Text
"Pandoc" Text
"b" Text
""
     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 Pandoc
pushPandoc Text
"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 -> Text -> 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) Text
"doc1" Text
"pandoc" Text
""
     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 (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) Text
"doc2" Text
"pandoc" Text
""
     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. Pusher e Bool
pushBool Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc" Text
""
    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. String -> LuaE e ()
pushString Text
"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 -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc" Text
"self"
      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 Pandoc
pushPandoc Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"self" Text
""
    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 Filter
peekFilter Text
"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 -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Meta
peekMeta Text
"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 -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Pandoc
pushPandoc Text
"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 -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Meta
peekMeta Text
"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 -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Meta
pushMeta Text
"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'