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

Marshaling/unmarshaling functions Lua filters, i.e., tables containing
functions to be called on specific elements.
-}
module Text.Pandoc.Lua.Marshal.Filter
  ( -- * Filters
    Filter (..)
  , WalkingOrder (..)
  , peekFilter
  , lookup
  , member
    -- * Individual filter functions
  , FilterFunction (..)
  , peekFilterFunction
  , pushFilterFunction
  , getFunctionFor
    -- * Names in filter functions
  , baseFunctionName
  , listFunctionName
  , valueFunctionNames
  ) where

import Prelude hiding (lookup)
import Control.Applicative ((<|>), optional)
import Control.Monad ((<$!>), void)
import Data.Data
  ( Data, dataTypeConstrs, dataTypeName, dataTypeOf
  , showConstr, toConstr, tyconUQname )
import Data.Foldable (foldrM)
import Data.Map (Map)
import Data.Proxy (Proxy (Proxy))
import Data.String (IsString (fromString))
import HsLua
import Text.Pandoc.Definition (Pandoc, Meta, Block, Inline)
import qualified Data.Map.Strict as Map

-- | Filter function stored in the registry
newtype FilterFunction = FilterFunction Reference

-- | Pushes a filter function to the stack.
--
-- Filter functions are stored in the registry and retrieved from there.
pushFilterFunction :: LuaError e => FilterFunction -> LuaE e ()
pushFilterFunction :: forall e. LuaError e => FilterFunction -> LuaE e ()
pushFilterFunction (FilterFunction Reference
fnRef) =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => StackIndex -> Reference -> LuaE e Type
getref StackIndex
registryindex Reference
fnRef

-- | Retrieves a filter function from the stack.
--
-- The value at the given index must be a function. It is stored in the
-- Lua registry.
peekFilterFunction :: Peeker e FilterFunction
peekFilterFunction :: forall e. Peeker e FilterFunction
peekFilterFunction = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"function" forall e. StackIndex -> LuaE e Bool
isfunction forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
  forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
  Reference -> FilterFunction
FilterFunction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. StackIndex -> LuaE e Reference
ref StackIndex
registryindex


-- | Collection of filter functions (at most one function per element
-- constructor)
data Filter = Filter
  { Filter -> WalkingOrder
filterWalkingOrder :: WalkingOrder
  , Filter -> Map Name FilterFunction
filterMap :: Map Name FilterFunction
  }

-- | Description of how an AST should be traversed.
data WalkingOrder
  = WalkForEachType  -- ^ Process each type separately, traversing the
                     -- tree bottom-up (leaves to root) for each type.
  | WalkTopdown      -- ^ Traverse the tree top-down, from root to
                     -- leaves and depth first, in a single traversal.

-- | Retrieves a default `Filter` object from the stack, suitable for
-- filtering a full document.
peekFilter :: LuaError e => Peeker e Filter
peekFilter :: forall e. LuaError e => Peeker e Filter
peekFilter = forall e. LuaError e => [Name] -> Peeker e Filter
peekFilter' forall a b. (a -> b) -> a -> b
$
    forall a. Data a => Proxy a -> Name
baseFunctionName (forall {k} (t :: k). Proxy t
Proxy @Pandoc)
  forall a. a -> [a] -> [a]
: forall a. Data a => Proxy a -> Name
baseFunctionName (forall {k} (t :: k). Proxy t
Proxy @Meta)
  forall a. a -> [a] -> [a]
: forall a. Data a => Proxy a -> Name
baseFunctionName (forall {k} (t :: k). Proxy t
Proxy @Block)
  forall a. a -> [a] -> [a]
: forall a. Data a => Proxy a -> Name
baseFunctionName (forall {k} (t :: k). Proxy t
Proxy @Inline)
  forall a. a -> [a] -> [a]
: forall a. Data a => Proxy a -> Name
listFunctionName (forall {k} (t :: k). Proxy t
Proxy @Block)
  forall a. a -> [a] -> [a]
: forall a. Data a => Proxy a -> Name
listFunctionName (forall {k} (t :: k). Proxy t
Proxy @Inline)
  forall a. a -> [a] -> [a]
:  forall a. Data a => Proxy a -> [Name]
valueFunctionNames (forall {k} (t :: k). Proxy t
Proxy @Inline)
  forall a. [a] -> [a] -> [a]
++ forall a. Data a => Proxy a -> [Name]
valueFunctionNames (forall {k} (t :: k). Proxy t
Proxy @Block)

-- | Retrieves a `Filter` object from the stack, fetching all functions
-- in the given list of names.
peekFilter' :: LuaError e => [Name] -> Peeker e Filter
peekFilter' :: forall e. LuaError e => [Name] -> Peeker e Filter
peekFilter' [Name]
fnNames StackIndex
idx = do
  let go :: Name -> Map Name FilterFunction -> Peek e (Map Name FilterFunction)
go Name
constr Map Name FilterFunction
acc = forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
        Type
_ <- forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
idx Name
constr
        forall e a. Peek e a -> LuaE e (Result a)
runPeek (forall e. Peeker e FilterFunction
peekFilterFunction StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Success FilterFunction
fn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
constr FilterFunction
fn Map Name FilterFunction
acc
          Failure {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Name FilterFunction
acc
  WalkingOrder
walkingSequence <- do
    Type
_ <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
idx Name
"traverse"
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e. Peeker e Text
peekText StackIndex
top) forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Text
"typewise" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WalkingOrder
WalkForEachType
      Just Text
"topdown"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WalkingOrder
WalkTopdown
      Maybe Text
_               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WalkingOrder
WalkForEachType
  WalkingOrder -> Map Name FilterFunction -> Filter
Filter WalkingOrder
walkingSequence forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM forall {e}.
LuaError e =>
Name -> Map Name FilterFunction -> Peek e (Map Name FilterFunction)
go forall k a. Map k a
Map.empty [Name]
fnNames

-- | Looks up a filter function in a Lua 'Filter'.
lookup :: Name -> Filter -> Maybe FilterFunction
lookup :: Name -> Filter -> Maybe FilterFunction
lookup Name
name = (Name
name forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Map Name FilterFunction
filterMap

-- | Checks whether the 'Filter' contains a function of the given name.
member :: Name -> Filter -> Bool
member :: Name -> Filter -> Bool
member Name
name = (Name
name forall k a. Ord k => k -> Map k a -> Bool
`Map.member`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Map Name FilterFunction
filterMap

-- | Filter function names for a given type.
valueFunctionNames :: forall a. Data a => Proxy a -> [Name]
valueFunctionNames :: forall a. Data a => Proxy a -> [Name]
valueFunctionNames Proxy a
_ = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> [Constr]
dataTypeConstrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf
                     forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: a)

-- | The name of a type's base function, which is called if there is no
-- more specific function for a value.
baseFunctionName :: forall a. Data a => Proxy a -> Name
baseFunctionName :: forall a. Data a => Proxy a -> Name
baseFunctionName Proxy a
_ =
  forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tyconUQname forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> String
dataTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf
  forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: a)

-- | The name of the functions that's called on lists of the given type.
listFunctionName :: forall a. Data a => Proxy a -> Name
listFunctionName :: forall a. Data a => Proxy a -> Name
listFunctionName Proxy a
_ =
  forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"s") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tyconUQname forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> String
dataTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf
  forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
undefined :: a)

-- | Finds the best filter function for a given element; returns
-- 'Nothing' if no such function exists.
getFunctionFor :: forall a. Data a => Filter -> a -> Maybe FilterFunction
getFunctionFor :: forall a. Data a => Filter -> a -> Maybe FilterFunction
getFunctionFor Filter
filter' a
x =
  let constrName :: Name
constrName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constr -> String
showConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Constr
toConstr forall a b. (a -> b) -> a -> b
$ a
x
      typeName :: Name
typeName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
tyconUQname forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> String
dataTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> DataType
dataTypeOf forall a b. (a -> b) -> a -> b
$ a
x
  in Name
constrName Name -> Filter -> Maybe FilterFunction
`lookup` Filter
filter' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Name
typeName   Name -> Filter -> Maybe FilterFunction
`lookup` Filter
filter'