{-# LANGUAGE OverloadedStrings    #-}
{- |
Copyright               : © 2021 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.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Lua.Marshal.Block
  (peekBlocksFuzzy, pushBlocks, walkBlockSplicing, walkBlocksStraight)
import Text.Pandoc.Lua.Marshal.Inline (walkInlineSplicing, walkInlinesStraight)
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 :: Pusher e Pandoc
pushPandoc = UDTypeWithList e (DocumentedFunction e) Pandoc Void
-> Pusher e Pandoc
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) Pandoc Void
forall e. LuaError e => DocumentedType e Pandoc
typePandoc

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

-- | Pandoc object type.
typePandoc :: LuaError e => DocumentedType e Pandoc
typePandoc :: DocumentedType e Pandoc
typePandoc = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Pandoc]
-> DocumentedType e Pandoc
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"Pandoc"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Eq (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ Name
-> (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__eq"
     ### liftPure2 (\a b -> fromMaybe False ((==) <$> a <*> b))
     HsFnPrecursor e (Maybe Pandoc -> Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc)
-> HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc1" Text
"pandoc" Text
""
     HsFnPrecursor e (Maybe Pandoc -> LuaE e Bool)
-> Parameter e (Maybe Pandoc) -> HsFnPrecursor e (LuaE e Bool)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e (Maybe Pandoc)
-> Text -> Text -> Text -> Parameter e (Maybe Pandoc)
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (Peek e Pandoc -> Peek e (Maybe Pandoc)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Pandoc -> Peek e (Maybe Pandoc))
-> (StackIndex -> Peek e Pandoc) -> Peeker e (Maybe Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc) Text
"doc2" Text
"pandoc" Text
""
     HsFnPrecursor e (LuaE e Bool)
-> FunctionResults e Bool -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Bool -> Text -> Text -> FunctionResults e Bool
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Bool
forall e. Pusher e Bool
pushBool Text
"boolean" Text
"true iff the two values are equal"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (Pandoc -> LuaE e String)
-> HsFnPrecursor e (Pandoc -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### liftPure show
    HsFnPrecursor e (Pandoc -> LuaE e String)
-> Parameter e Pandoc -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Pandoc)
-> Text -> Text -> Text -> Parameter e Pandoc
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"doc" Text
""
    HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"native Haskell representation"
  ]
  [ Name
-> Text
-> (Pusher e [Block], Pandoc -> [Block])
-> (Peeker e [Block], Pandoc -> [Block] -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
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"
      (Pusher e [Block]
forall e. LuaError e => Pusher e [Block]
pushBlocks, \(Pandoc Meta
_ [Block]
blks) -> [Block]
blks)
      (Peeker e [Block]
forall e. LuaError e => Peeker e [Block]
peekBlocksFuzzy, \(Pandoc Meta
m [Block]
_) [Block]
blks -> Meta -> [Block] -> Pandoc
Pandoc Meta
m [Block]
blks)
  , Name
-> Text
-> (Pusher e Meta, Pandoc -> Meta)
-> (Peeker e Meta, Pandoc -> Meta -> Pandoc)
-> Member e (DocumentedFunction e) Pandoc
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"
      (Pusher e Meta
forall e. LuaError e => Pusher e Meta
pushMeta, \(Pandoc Meta
meta [Block]
_) -> Meta
meta)
      (Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta, \(Pandoc Meta
_ [Block]
blks) Meta
meta -> Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blks)

  , DocumentedFunction e -> Member e (DocumentedFunction e) Pandoc
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method (DocumentedFunction e -> Member e (DocumentedFunction e) Pandoc)
-> DocumentedFunction e -> Member e (DocumentedFunction e) Pandoc
forall a b. (a -> b) -> a -> b
$ Name
-> (Pandoc -> Filter -> LuaE e Pandoc)
-> HsFnPrecursor e (Pandoc -> Filter -> LuaE e Pandoc)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"walk"
    ### (\doc filter' -> case filterWalkingOrder filter' of
            WalkForEachType -> walkBlocksAndInlines filter' doc
                           >>= applyMetaFunction filter'
                           >>= applyPandocFunction filter'
            WalkTopdown     -> applyPandocFunction filter' doc
                           >>= applyMetaFunction filter'
                           >>= walkBlocksAndInlines filter')
    HsFnPrecursor e (Pandoc -> Filter -> LuaE e Pandoc)
-> Parameter e Pandoc -> HsFnPrecursor e (Filter -> LuaE e Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> (StackIndex -> Peek e Pandoc)
-> Text -> Text -> Text -> Parameter e Pandoc
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter StackIndex -> Peek e Pandoc
forall e. LuaError e => Peeker e Pandoc
peekPandoc Text
"Pandoc" Text
"self" Text
""
    HsFnPrecursor e (Filter -> LuaE e Pandoc)
-> Parameter e Filter -> HsFnPrecursor e (LuaE e Pandoc)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Filter -> Text -> Text -> Text -> Parameter e Filter
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Filter
forall e. LuaError e => Peeker e Filter
peekFilter Text
"Filter" Text
"lua_filter" Text
"table of filter functions"
    HsFnPrecursor e (LuaE e Pandoc)
-> FunctionResults e Pandoc -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Pandoc -> Text -> Text -> FunctionResults e Pandoc
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Pandoc
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 :: Pusher e Meta
pushMeta (Meta Map Text MetaValue
mmap) = do
  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
mmap
  Bool
_ <- Name -> LuaE e Bool
forall e. Name -> LuaE e Bool
newmetatable Name
"Meta"
  StackIndex -> LuaE e ()
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 :: Peeker e Meta
peekMeta StackIndex
idx = Name -> Peek e Meta -> Peek e Meta
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Meta" (Peek e Meta -> Peek e Meta) -> Peek e Meta -> Peek e Meta
forall a b. (a -> b) -> a -> b
$
  Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta)
-> Peek e (Map Text MetaValue) -> Peek e Meta
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

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

-- | Constructor for 'Meta' values.
mkMeta :: LuaError e => DocumentedFunction e
mkMeta :: DocumentedFunction e
mkMeta = Name
-> (Meta -> LuaE e Meta) -> HsFnPrecursor e (Meta -> LuaE e Meta)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Meta"
  ### liftPure id
  HsFnPrecursor e (Meta -> LuaE e Meta)
-> Parameter e Meta -> HsFnPrecursor e (LuaE e Meta)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e Meta -> Text -> Text -> Text -> Parameter e Meta
forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta Text
"table" Text
"meta" Text
"table containing meta information"
  HsFnPrecursor e (LuaE e Meta)
-> FunctionResults e Meta -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e Meta -> Text -> Text -> FunctionResults e Meta
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e Meta
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 :: Filter -> Pandoc -> LuaE e Pandoc
applyPandocFunction = Pusher e Pandoc
-> Peeker e Pandoc -> Filter -> Pandoc -> LuaE e Pandoc
forall e a.
(LuaError e, Data a) =>
Pusher e a -> Peeker e a -> Filter -> a -> LuaE e a
applyStraight Pusher e Pandoc
forall e. LuaError e => Pusher e Pandoc
pushPandoc Peeker e Pandoc
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 :: Filter -> Pandoc -> LuaE e Pandoc
applyMetaFunction Filter
filter' (Pandoc Meta
meta [Block]
blocks) = do
  Meta
meta' <- Pusher e Meta -> Peeker e Meta -> Filter -> Meta -> LuaE e Meta
forall e a.
(LuaError e, Data a) =>
Pusher e a -> Peeker e a -> Filter -> a -> LuaE e a
applyStraight Pusher e Meta
forall e. LuaError e => Pusher e Meta
pushMeta Peeker e Meta
forall e. LuaError e => Peeker e Meta
peekMeta Filter
filter' Meta
meta
  Pandoc -> LuaE e Pandoc
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 :: Filter -> Pandoc -> LuaE e Pandoc
applyFully Filter
filter' =
      Filter -> Pandoc -> LuaE e Pandoc
forall e a.
(LuaError e, Walkable (SpliceList Inline) a) =>
Filter -> a -> LuaE e a
walkInlineSplicing Filter
filter'
  (Pandoc -> LuaE e Pandoc)
-> (Pandoc -> LuaE e Pandoc) -> Pandoc -> LuaE e Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Filter -> Pandoc -> LuaE e Pandoc
forall e a.
(LuaError e, Walkable [Inline] a) =>
Filter -> a -> LuaE e a
walkInlinesStraight Filter
filter'
  (Pandoc -> LuaE e Pandoc)
-> (Pandoc -> LuaE e Pandoc) -> Pandoc -> LuaE e Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Filter -> Pandoc -> LuaE e Pandoc
forall e a.
(LuaError e, Walkable (SpliceList Block) a) =>
Filter -> a -> LuaE e a
walkBlockSplicing Filter
filter'
  (Pandoc -> LuaE e Pandoc)
-> (Pandoc -> LuaE e Pandoc) -> Pandoc -> LuaE e Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Filter -> Pandoc -> LuaE e Pandoc
forall e a.
(LuaError e, Walkable [Block] a) =>
Filter -> a -> LuaE e a
walkBlocksStraight Filter
filter'
  (Pandoc -> LuaE e Pandoc)
-> (Pandoc -> LuaE e Pandoc) -> Pandoc -> LuaE e Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Filter -> Pandoc -> LuaE e Pandoc
forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyMetaFunction Filter
filter'
  (Pandoc -> LuaE e Pandoc)
-> (Pandoc -> LuaE e Pandoc) -> Pandoc -> LuaE e Pandoc
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Filter -> Pandoc -> LuaE e Pandoc
forall e. LuaError e => Filter -> Pandoc -> LuaE e Pandoc
applyPandocFunction Filter
filter'