    {-# LANGUAGE LambdaCase           #-}
    {-# LANGUAGE OverloadedStrings    #-}
    {-# LANGUAGE TypeApplications     #-}
    {-# LANGUAGE ScopedTypeVariables  #-}
    {- |
    Copyright  : © 2021-2025 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) =
      LuaE e Type -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ StackIndex -> Reference -> LuaE e Type
    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 = Name
    -> (StackIndex -> LuaE e Bool)
    -> Peeker e FilterFunction
    -> Peeker e FilterFunction
    forall e a.
    Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
    typeChecked Name
    "function" StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    isfunction (Peeker e FilterFunction -> Peeker e FilterFunction)
    -> Peeker e FilterFunction -> Peeker e FilterFunction
    forall a b. (a -> b) -> a -> b
    $ \StackIndex
    idx -> LuaE e FilterFunction -> Peek e FilterFunction
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e FilterFunction -> Peek e FilterFunction)
    -> LuaE e FilterFunction -> Peek e FilterFunction
    forall a b. (a -> b) -> a -> b
    $ do
      StackIndex -> LuaE e ()
    forall e. StackIndex -> LuaE e ()
    pushvalue StackIndex
    idx
      Reference -> FilterFunction
    FilterFunction (Reference -> FilterFunction)
    -> LuaE e Reference -> LuaE e FilterFunction
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> LuaE e Reference
    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 = [Name] -> Peeker e Filter
    forall e. LuaError e => [Name] -> Peeker e Filter
    peekFilter' ([Name] -> Peeker e Filter) -> [Name] -> Peeker e Filter
    forall a b. (a -> b) -> a -> b
    $
        Proxy Pandoc -> Name
    forall a. Data a => Proxy a -> Name
    baseFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Pandoc)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Proxy Meta -> Name
    forall a. Data a => Proxy a -> Name
    baseFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Meta)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Proxy Block -> Name
    forall a. Data a => Proxy a -> Name
    baseFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Block)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Proxy Inline -> Name
    forall a. Data a => Proxy a -> Name
    baseFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Inline)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Proxy Block -> Name
    forall a. Data a => Proxy a -> Name
    listFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Block)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    : Proxy Inline -> Name
    forall a. Data a => Proxy a -> Name
    listFunctionName (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Inline)
      Name -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :  Proxy Inline -> [Name]
    forall a. Data a => Proxy a -> [Name]
    valueFunctionNames (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @Inline)
      [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ Proxy Block -> [Name]
    forall a. Data a => Proxy a -> [Name]
    valueFunctionNames (forall t. Proxy t
    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 = LuaE e (Map Name FilterFunction)
    -> Peek e (Map Name FilterFunction)
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e (Map Name FilterFunction)
     -> Peek e (Map Name FilterFunction))
    -> LuaE e (Map Name FilterFunction)
    -> Peek e (Map Name FilterFunction)
    forall a b. (a -> b) -> a -> b
    $ do
            _ <- StackIndex -> Name -> LuaE e Type
    forall e. LuaError e => StackIndex -> Name -> LuaE e Type
    getfield StackIndex
    idx Name
    constr
            runPeek (peekFilterFunction top `lastly` pop 1) >>= \case
              Success FilterFunction
    fn -> Map Name FilterFunction -> LuaE e (Map Name FilterFunction)
    forall a. a -> LuaE e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map Name FilterFunction -> LuaE e (Map Name FilterFunction))
    -> Map Name FilterFunction -> LuaE e (Map Name FilterFunction)
    forall a b. (a -> b) -> a -> b
    $ Name
    -> FilterFunction
    -> Map Name FilterFunction
    -> Map Name FilterFunction
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Name
    constr FilterFunction
    fn Map Name FilterFunction
    acc
              Failure {} -> Map Name FilterFunction -> LuaE e (Map Name FilterFunction)
    forall a. a -> LuaE e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Map Name FilterFunction
    acc
      walkingSequence <- do
        _ <- LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e Type -> Peek e Type) -> LuaE e Type -> Peek e Type
    forall a b. (a -> b) -> a -> b
    $ StackIndex -> Name -> LuaE e Type
    forall e. LuaError e => StackIndex -> Name -> LuaE e Type
    getfield StackIndex
    idx Name
    "traverse"
        optional (peekText top) `lastly` pop 1 >>= \case
          Just Text
    "typewise" -> WalkingOrder -> Peek e WalkingOrder
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure WalkingOrder
    WalkForEachType
          Just Text
    "topdown"  -> WalkingOrder -> Peek e WalkingOrder
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure WalkingOrder
    WalkTopdown
          Maybe Text
    _               -> WalkingOrder -> Peek e WalkingOrder
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure WalkingOrder
    WalkForEachType
      Filter walkingSequence <$!> foldrM go Map.empty 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 Name -> Map Name FilterFunction -> Maybe FilterFunction
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup`) (Map Name FilterFunction -> Maybe FilterFunction)
    -> (Filter -> Map Name FilterFunction)
    -> Filter
    -> Maybe FilterFunction
    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 Name -> Map Name FilterFunction -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.member`) (Map Name FilterFunction -> Bool)
    -> (Filter -> Map Name FilterFunction) -> Filter -> Bool
    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
    _ = (Constr -> Name) -> [Constr] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Name
    forall a. IsString a => String -> a
    fromString (String -> Name) -> (Constr -> String) -> Constr -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Constr -> String
    forall a. Show a => a -> String
    show) ([Constr] -> [Name]) -> (a -> [Constr]) -> a -> [Name]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataType -> [Constr]
    dataTypeConstrs (DataType -> [Constr]) -> (a -> DataType) -> a -> [Constr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf
                         (a -> [Name]) -> a -> [Name]
    forall a b. (a -> b) -> a -> b
    $ (a
    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
    _ =
      String -> Name
    forall a. IsString a => String -> a
    fromString (String -> Name) -> (a -> String) -> a -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    tyconUQname (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataType -> String
    dataTypeName (DataType -> String) -> (a -> DataType) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf
      (a -> Name) -> a -> Name
    forall a b. (a -> b) -> a -> b
    $ (a
    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
    _ =
      String -> Name
    forall a. IsString a => String -> a
    fromString (String -> Name) -> (a -> String) -> a -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "s") (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    tyconUQname (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataType -> String
    dataTypeName (DataType -> String) -> (a -> DataType) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf
      (a -> Name) -> a -> Name
    forall a b. (a -> b) -> a -> b
    $ (a
    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 = String -> Name
    forall a. IsString a => String -> a
    fromString (String -> Name) -> (a -> String) -> a -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Constr -> String
    showConstr (Constr -> String) -> (a -> Constr) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Constr
    forall a. Data a => a -> Constr
    toConstr (a -> Name) -> a -> Name
    forall a b. (a -> b) -> a -> b
    $ a
    x
          typeName :: Name
    typeName = String -> Name
    forall a. IsString a => String -> a
    fromString (String -> Name) -> (a -> String) -> a -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    tyconUQname (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataType -> String
    dataTypeName (DataType -> String) -> (a -> DataType) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf (a -> Name) -> a -> Name
    forall a b. (a -> b) -> a -> b
    $ a
    x
      in Name
    constrName Name -> Filter -> Maybe FilterFunction
    `lookup` Filter
    filter' Maybe FilterFunction
    -> Maybe FilterFunction -> Maybe FilterFunction
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
         Name
    typeName   Name -> Filter -> Maybe FilterFunction
    `lookup` Filter
    filter'