{-# 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) =
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
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
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 = 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)
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
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
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
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)
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)
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)
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'