{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{- |
Module      : Text.Pandoc.Lua.Walk
Copyright   : © 2012-2021 John MacFarlane,
              © 2017-2021 Albert Krewinkel
License     : GNU GPL, version 2 or above
Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Walking documents in a filter-suitable way.
-}
module Text.Pandoc.Lua.Walk
  ( SpliceList (..)
  , Walkable
  , TraversalControl (..)
  , walkSplicing
  , walkStraight
  , applyStraight
  , applySplicing
  , applyStraightFunction
  , applySplicingFunction
  )
where

import Prelude hiding (lookup)
import Control.Applicative ((<|>))
import Control.Monad ((<$!>))
import Data.Data (Data)
import Data.Proxy (Proxy (..))
import HsLua
import Text.Pandoc.Lua.Marshal.Filter
import Text.Pandoc.Lua.SpliceList (SpliceList (..))
import Text.Pandoc.Walk

--
-- Straight
--

-- | Walks an element, modifying all values of type @a@ by applying the
-- given Lua 'Filter'.
walkStraight :: forall e a b. (LuaError e, Walkable a b)
             => Name  -- ^ Name under which the filter function is stored
             -> Pusher e a
             -> Peeker e a
             -> Filter
             -> b -> LuaE e b
walkStraight :: Name -> Pusher e a -> Peeker e a -> Filter -> b -> LuaE e b
walkStraight Name
filterFnName Pusher e a
pushElement Peeker e a
peekElement Filter
filter' =
  case Name
filterFnName Name -> Filter -> Maybe FilterFunction
`lookup` Filter
filter' of
    Maybe FilterFunction
Nothing ->
      -- There is no filter function, do nothing.
      b -> LuaE e b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Just FilterFunction
fn ->
      -- Walk the element with the filter function.
      (a -> LuaE e a) -> b -> LuaE e b
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM ((a -> LuaE e a) -> b -> LuaE e b)
-> (a -> LuaE e a) -> b -> LuaE e b
forall a b. (a -> b) -> a -> b
$ ((a, TraversalControl) -> a)
-> LuaE e (a, TraversalControl) -> LuaE e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, TraversalControl) -> a
forall a b. (a, b) -> a
fst (LuaE e (a, TraversalControl) -> LuaE e a)
-> (a -> LuaE e (a, TraversalControl)) -> a -> LuaE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterFunction
-> Pusher e a -> Peeker e a -> a -> LuaE e (a, TraversalControl)
forall e a.
LuaError e =>
FilterFunction
-> Pusher e a -> Peeker e a -> a -> LuaE e (a, TraversalControl)
applyStraightFunction FilterFunction
fn Pusher e a
pushElement Peeker e a
peekElement

-- | Applies a filter on an element. The element is pushed to the stack
-- via the given pusher and calls the filter function with that value,
-- leaving the filter function's return value on the stack.
applyStraight :: (LuaError e, Data a)
              => Pusher e a -> Peeker e a -> Filter
              -> a -> LuaE e a
applyStraight :: Pusher e a -> Peeker e a -> Filter -> a -> LuaE e a
applyStraight Pusher e a
pushElement Peeker e a
peekElement Filter
filter' a
x = do
  case Filter
filter' Filter -> a -> Maybe FilterFunction
forall a. Data a => Filter -> a -> Maybe FilterFunction
`getFunctionFor` a
x of
    Maybe FilterFunction
Nothing ->
      -- There is no filter function, do nothing.
      a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Just FilterFunction
fn -> (a, TraversalControl) -> a
forall a b. (a, b) -> a
fst ((a, TraversalControl) -> a)
-> LuaE e (a, TraversalControl) -> LuaE e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      -- Apply the function
      FilterFunction
-> Pusher e a -> Peeker e a -> a -> LuaE e (a, TraversalControl)
forall e a.
LuaError e =>
FilterFunction
-> Pusher e a -> Peeker e a -> a -> LuaE e (a, TraversalControl)
applyStraightFunction FilterFunction
fn Pusher e a
pushElement Peeker e a
peekElement a
x

-- | Applies a single filter function on an element. The element is
-- pushed to the stack via the given pusher and calls the filter
-- function with that value, leaving the filter function's return value
-- on the stack.
applyStraightFunction :: LuaError e
                      => FilterFunction -> Pusher e a -> Peeker e a
                      -> a -> LuaE e (a, TraversalControl)
applyStraightFunction :: FilterFunction
-> Pusher e a -> Peeker e a -> a -> LuaE e (a, TraversalControl)
applyStraightFunction FilterFunction
fn Pusher e a
pushElement Peeker e a
peekElement a
x = do
  FilterFunction -> LuaE e ()
forall e. LuaError e => FilterFunction -> LuaE e ()
pushFilterFunction FilterFunction
fn
  Pusher e a
pushElement a
x
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
1 NumResults
2
  Peek e (a, TraversalControl) -> LuaE e (a, TraversalControl)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e (a, TraversalControl) -> LuaE e (a, TraversalControl))
-> (Peek e (a, TraversalControl) -> Peek e (a, TraversalControl))
-> Peek e (a, TraversalControl)
-> LuaE e (a, TraversalControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peek e (a, TraversalControl)
-> LuaE e () -> Peek e (a, TraversalControl)
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
2) (Peek e (a, TraversalControl) -> LuaE e (a, TraversalControl))
-> Peek e (a, TraversalControl) -> LuaE e (a, TraversalControl)
forall a b. (a -> b) -> a -> b
$
    (,)
    (a -> TraversalControl -> (a, TraversalControl))
-> Peek e a -> Peek e (TraversalControl -> (a, TraversalControl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a
x a -> Peek e () -> Peek e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Peeker e ()
forall e. Peeker e ()
peekNil (CInt -> StackIndex
nth CInt
2)) Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Peeker e a
peekElement (CInt -> StackIndex
nth CInt
2))
    Peek e (TraversalControl -> (a, TraversalControl))
-> Peek e TraversalControl -> Peek e (a, TraversalControl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e TraversalControl
forall e. Peeker e TraversalControl
peekTraversalControl StackIndex
top

--
-- Splicing
--

-- | Walks an element, using a Lua 'Filter' to modify all values of type
-- @a@ that are in a list. The result of the called filter function must
-- be a retrieved as a list, and it is spliced back into the list at the
-- position of the original element. This allows to delete an element,
-- or to replace an element with multiple elements.
walkSplicing :: forall e a b. (LuaError e, Data a, Walkable (SpliceList a) b)
             => Pusher e a
             -> Peeker e [a]
             -> Filter
             -> b -> LuaE e b
walkSplicing :: Pusher e a -> Peeker e [a] -> Filter -> b -> LuaE e b
walkSplicing Pusher e a
pushElement Peeker e [a]
peekElementOrList Filter
filter' =
  if (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> Filter -> Bool
`member` Filter
filter') [Name]
acceptedNames
  then (SpliceList a -> LuaE e (SpliceList a)) -> b -> LuaE e b
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM ((SpliceList a -> LuaE e (SpliceList a)) -> b -> LuaE e b)
-> (SpliceList a -> LuaE e (SpliceList a)) -> b -> LuaE e b
forall a b. (a -> b) -> a -> b
$ \(SpliceList [a]
xs) -> [a] -> SpliceList a
forall a. [a] -> SpliceList a
SpliceList ([a] -> SpliceList a) -> LuaE e [a] -> LuaE e (SpliceList a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([[a]] -> [a]) -> LuaE e [[a]] -> LuaE e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ((a -> LuaE e [a]) -> [a] -> LuaE e [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> LuaE e [a]
f [a]
xs)
  else b -> LuaE e b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
 where
  f :: a -> LuaE e [a]
  f :: a -> LuaE e [a]
f = Pusher e a -> Peeker e [a] -> Filter -> a -> LuaE e [a]
forall e a.
(LuaError e, Data a) =>
Pusher e a -> Peeker e [a] -> Filter -> a -> LuaE e [a]
applySplicing Pusher e a
pushElement Peeker e [a]
peekElementOrList Filter
filter'

  acceptedNames :: [Name]
  acceptedNames :: [Name]
acceptedNames = Proxy a -> Name
forall a. Data a => Proxy a -> Name
baseFunctionName (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: Proxy a -> [Name]
forall a. Data a => Proxy a -> [Name]
valueFunctionNames (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

-- | Applies a filter on an element. The element is pushed to the stack
-- via the given pusher and calls the filter function with that value,
-- leaving the filter function's return value on the stack.
applySplicing :: (LuaError e, Data a)
              => Pusher e a -> Peeker e [a] -> Filter
              -> a -> LuaE e [a]
applySplicing :: Pusher e a -> Peeker e [a] -> Filter -> a -> LuaE e [a]
applySplicing Pusher e a
pushElement Peeker e [a]
peekElements Filter
filter' a
x = do
  case Filter
filter' Filter -> a -> Maybe FilterFunction
forall a. Data a => Filter -> a -> Maybe FilterFunction
`getFunctionFor` a
x of
    Maybe FilterFunction
Nothing ->
      -- There is no filter function, do nothing.
      [a] -> LuaE e [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
x]
    Just FilterFunction
fn -> ([a], TraversalControl) -> [a]
forall a b. (a, b) -> a
fst (([a], TraversalControl) -> [a])
-> LuaE e ([a], TraversalControl) -> LuaE e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      -- Apply the function
      FilterFunction
-> Pusher e a
-> Peeker e [a]
-> a
-> LuaE e ([a], TraversalControl)
forall e a.
LuaError e =>
FilterFunction
-> Pusher e a
-> Peeker e [a]
-> a
-> LuaE e ([a], TraversalControl)
applySplicingFunction FilterFunction
fn Pusher e a
pushElement Peeker e [a]
peekElements a
x

-- | Applies a single filter function on an element. The element is
-- pushed to the stack via the given pusher and calls the filter
-- function with that value, leaving the filter function's return value
-- on the stack.
applySplicingFunction :: LuaError e
                      => FilterFunction -> Pusher e a -> Peeker e [a]
                      -> a -> LuaE e ([a], TraversalControl)
applySplicingFunction :: FilterFunction
-> Pusher e a
-> Peeker e [a]
-> a
-> LuaE e ([a], TraversalControl)
applySplicingFunction FilterFunction
fn Pusher e a
pushElement Peeker e [a]
peekElements a
x = do
  FilterFunction -> LuaE e ()
forall e. LuaError e => FilterFunction -> LuaE e ()
pushFilterFunction FilterFunction
fn
  Pusher e a
pushElement a
x
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
callTrace NumArgs
1 NumResults
2
  Peek e ([a], TraversalControl) -> LuaE e ([a], TraversalControl)
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e ([a], TraversalControl) -> LuaE e ([a], TraversalControl))
-> (Peek e ([a], TraversalControl)
    -> Peek e ([a], TraversalControl))
-> Peek e ([a], TraversalControl)
-> LuaE e ([a], TraversalControl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peek e ([a], TraversalControl)
-> LuaE e () -> Peek e ([a], TraversalControl)
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
2) (Peek e ([a], TraversalControl) -> LuaE e ([a], TraversalControl))
-> Peek e ([a], TraversalControl) -> LuaE e ([a], TraversalControl)
forall a b. (a -> b) -> a -> b
$
    (,)
    ([a] -> TraversalControl -> ([a], TraversalControl))
-> Peek e [a]
-> Peek e (TraversalControl -> ([a], TraversalControl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (CInt -> StackIndex
nth CInt
2)) Peek e Type -> (Type -> Peek e [a]) -> Peek e [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Type
TypeNil -> [a] -> Peek e [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
x]  -- function returned `nil`, keep original value
            Type
_       -> Peeker e [a]
peekElements (CInt -> StackIndex
nth CInt
2))
    Peek e (TraversalControl -> ([a], TraversalControl))
-> Peek e TraversalControl -> Peek e ([a], TraversalControl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e TraversalControl
forall e. Peeker e TraversalControl
peekTraversalControl StackIndex
top

--
-- Helper
--

data TraversalControl = Continue | Stop

-- | Retrieves a Traversal control value: @nil@ or a truthy value
-- translate to 'Continue', @false@ is treated to mean 'Stop'.
peekTraversalControl :: Peeker e TraversalControl
peekTraversalControl :: Peeker e TraversalControl
peekTraversalControl StackIndex
idx = (TraversalControl
Continue TraversalControl -> Peek e () -> Peek e TraversalControl
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Peeker e ()
forall e. Peeker e ()
peekNil StackIndex
idx)
  Peek e TraversalControl
-> Peek e TraversalControl -> Peek e TraversalControl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (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
toboolean StackIndex
top) Peek e Bool
-> (Bool -> Peek e TraversalControl) -> Peek e TraversalControl
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> TraversalControl -> Peek e TraversalControl
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraversalControl
Continue
          Bool
False -> TraversalControl -> Peek e TraversalControl
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraversalControl
Stop)