{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Lua.Marshal.Filter
(
Filter (..)
, WalkingOrder (..)
, peekFilter
, lookup
, member
, FilterFunction (..)
, peekFilterFunction
, pushFilterFunction
, getFunctionFor
, 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
newtype FilterFunction = FilterFunction Reference
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
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
data Filter = Filter
{ Filter -> WalkingOrder
filterWalkingOrder :: WalkingOrder
, Filter -> Map Name FilterFunction
filterMap :: Map Name FilterFunction
}
data WalkingOrder
= WalkForEachType
| WalkTopdown
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)
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
Type
_ <- StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
idx Name
constr
Peek e FilterFunction -> LuaE e (Result FilterFunction)
forall e a. Peek e a -> LuaE e (Result a)
runPeek (Peeker e FilterFunction
forall e. Peeker e FilterFunction
peekFilterFunction StackIndex
top Peek e FilterFunction -> LuaE e () -> Peek e FilterFunction
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1) LuaE e (Result FilterFunction)
-> (Result FilterFunction -> LuaE e (Map Name FilterFunction))
-> LuaE e (Map Name FilterFunction)
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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
WalkingOrder
walkingSequence <- do
Type
_ <- 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"
Peek e Text -> Peek e (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Text
forall e. Peeker e Text
peekText StackIndex
top) Peek e (Maybe Text) -> LuaE e () -> Peek e (Maybe Text)
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 Peek e (Maybe Text)
-> (Maybe Text -> Peek e WalkingOrder) -> Peek e WalkingOrder
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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
WalkingOrder -> Map Name FilterFunction -> Filter
Filter WalkingOrder
walkingSequence (Map Name FilterFunction -> Filter)
-> Peek e (Map Name FilterFunction) -> Peek e Filter
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Name
-> Map Name FilterFunction -> Peek e (Map Name FilterFunction))
-> Map Name FilterFunction
-> [Name]
-> Peek e (Map Name FilterFunction)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM Name -> Map Name FilterFunction -> Peek e (Map Name FilterFunction)
forall {e}.
LuaError e =>
Name -> Map Name FilterFunction -> Peek e (Map Name FilterFunction)
go Map Name FilterFunction
forall k a. Map k a
Map.empty [Name]
fnNames
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
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
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)
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)
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)
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'