{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Pandoc.Lua.Marshal.Format
( peekExtensions
, pushExtensions
, peekExtensionsConfig
, pushExtensionsConfig
, peekFlavoredFormat
) where
import Control.Applicative ((<|>))
import Control.Monad ((<$!>))
import Data.Maybe (fromMaybe)
import HsLua
import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Extensions
( Extension, Extensions, extensionsFromList, extensionsToList
, getDefaultExtensions, readExtension, showExtension )
import Text.Pandoc.Format
( ExtensionsConfig (..), ExtensionsDiff (..), FlavoredFormat (..)
, diffExtensions, parseFlavoredFormat)
import Text.Pandoc.Lua.PandocLua (PandocLua (unPandocLua))
peekExtension :: LuaError e => Peeker e Extension
peekExtension :: Peeker e Extension
peekExtension StackIndex
idx = do
String
extString <- Peeker e String
forall e. Peeker e String
peekString StackIndex
idx
Extension -> Peek e Extension
forall (m :: * -> *) a. Monad m => a -> m a
return (Extension -> Peek e Extension) -> Extension -> Peek e Extension
forall a b. (a -> b) -> a -> b
$ String -> Extension
readExtension String
extString
{-# INLINE peekExtension #-}
pushExtension :: LuaError e => Pusher e Extension
pushExtension :: Pusher e Extension
pushExtension = Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Extension -> Text) -> Pusher e Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Text
showExtension
{-# INLINE pushExtension #-}
peekExtensions :: LuaError e => Peeker e Extensions
peekExtensions :: Peeker e Extensions
peekExtensions = ([Extension] -> Extensions)
-> Peek e [Extension] -> Peek e Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Extension] -> Extensions
extensionsFromList (Peek e [Extension] -> Peek e Extensions)
-> (StackIndex -> Peek e [Extension]) -> Peeker e Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Extension -> StackIndex -> Peek e [Extension]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Extension
forall e. LuaError e => Peeker e Extension
peekExtension
{-# INLINE peekExtensions #-}
pushExtensions :: LuaError e => Pusher e Extensions
pushExtensions :: Pusher e Extensions
pushExtensions = Pusher e Extensions
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON
{-# INLINE pushExtensions #-}
instance Peekable Extensions where
safepeek :: Peeker e Extensions
safepeek = Peeker e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions
instance Pushable Extensions where
push :: Extensions -> LuaE e ()
push = Extensions -> LuaE e ()
forall e. LuaError e => Extensions -> LuaE e ()
pushExtensions
peekExtensionsConfig :: LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig :: Peeker e ExtensionsConfig
peekExtensionsConfig StackIndex
idx = do
ExtensionsDiff
diff <- Peeker e ExtensionsDiff
forall e. LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff StackIndex
idx
ExtensionsConfig -> Peek e ExtensionsConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionsConfig -> Peek e ExtensionsConfig)
-> ExtensionsConfig -> Peek e ExtensionsConfig
forall a b. (a -> b) -> a -> b
$ ExtensionsConfig :: Extensions -> Extensions -> ExtensionsConfig
ExtensionsConfig
{ extsDefault :: Extensions
extsDefault = ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
diff
, extsSupported :: Extensions
extsSupported = ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
diff Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> ExtensionsDiff -> Extensions
extsToDisable ExtensionsDiff
diff
}
pushExtensionsConfig :: LuaError e => Pusher e ExtensionsConfig
pushExtensionsConfig :: Pusher e ExtensionsConfig
pushExtensionsConfig (ExtensionsConfig Extensions
def Extensions
supported) =
Pusher e Extension -> Pusher e Bool -> Pusher e [(Extension, Bool)]
forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e [(a, b)]
pushKeyValuePairs Pusher e Extension
forall e. LuaError e => Pusher e Extension
pushExtension Pusher e Bool
forall e. Pusher e Bool
pushBool Pusher e [(Extension, Bool)] -> Pusher e [(Extension, Bool)]
forall a b. (a -> b) -> a -> b
$
(Extension -> (Extension, Bool))
-> [Extension] -> [(Extension, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
False) (Extensions -> [Extension]
extensionsToList Extensions
supported) [(Extension, Bool)] -> [(Extension, Bool)] -> [(Extension, Bool)]
forall a. [a] -> [a] -> [a]
++
(Extension -> (Extension, Bool))
-> [Extension] -> [(Extension, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (,Bool
True) (Extensions -> [Extension]
extensionsToList Extensions
def)
instance Peekable ExtensionsConfig where
safepeek :: Peeker e ExtensionsConfig
safepeek = Peeker e ExtensionsConfig
forall e. LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig
peekExtensionsDiff :: LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff :: Peeker e ExtensionsDiff
peekExtensionsDiff = Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e ExtensionsDiff
-> Peeker e ExtensionsDiff
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable (Peeker e ExtensionsDiff -> Peeker e ExtensionsDiff)
-> Peeker e ExtensionsDiff -> Peeker e ExtensionsDiff
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
(do
Maybe Extensions
en <- Peeker e (Maybe Extensions) -> Name -> Peeker e (Maybe Extensions)
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e (Maybe Extensions) -> Peeker e (Maybe Extensions)
forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr ((Extensions -> Maybe Extensions)
-> Peek e Extensions -> Peek e (Maybe Extensions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extensions -> Maybe Extensions
forall a. a -> Maybe a
Just (Peek e Extensions -> Peek e (Maybe Extensions))
-> (StackIndex -> Peek e Extensions) -> Peeker e (Maybe Extensions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions)) Name
"enable" StackIndex
idx
Maybe Extensions
di <- Peeker e (Maybe Extensions) -> Name -> Peeker e (Maybe Extensions)
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker e (Maybe Extensions) -> Peeker e (Maybe Extensions)
forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr ((Extensions -> Maybe Extensions)
-> Peek e Extensions -> Peek e (Maybe Extensions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extensions -> Maybe Extensions
forall a. a -> Maybe a
Just (Peek e Extensions -> Peek e (Maybe Extensions))
-> (StackIndex -> Peek e Extensions) -> Peeker e (Maybe Extensions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions)) Name
"disable" StackIndex
idx
if (Maybe Extensions
en, Maybe Extensions
di) (Maybe Extensions, Maybe Extensions)
-> (Maybe Extensions, Maybe Extensions) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Extensions
forall a. Maybe a
Nothing, Maybe Extensions
forall a. Maybe a
Nothing)
then ByteString -> Peek e ExtensionsDiff
forall a e. ByteString -> Peek e a
failPeek ByteString
"At least on of 'enable' and 'disable' must be set"
else ExtensionsDiff -> Peek e ExtensionsDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionsDiff -> Peek e ExtensionsDiff)
-> ExtensionsDiff -> Peek e ExtensionsDiff
forall a b. (a -> b) -> a -> b
$
Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff (Extensions -> Maybe Extensions -> Extensions
forall a. a -> Maybe a -> a
fromMaybe Extensions
forall a. Monoid a => a
mempty Maybe Extensions
en) (Extensions -> Maybe Extensions -> Extensions
forall a. a -> Maybe a -> a
fromMaybe Extensions
forall a. Monoid a => a
mempty Maybe Extensions
di))
Peek e ExtensionsDiff
-> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((Extensions -> Extensions -> ExtensionsDiff)
-> (Extensions, Extensions) -> ExtensionsDiff
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff ((Extensions, Extensions) -> ExtensionsDiff)
-> Peek e (Extensions, Extensions) -> Peek e ExtensionsDiff
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (StackIndex -> Peek e Extensions)
-> (StackIndex -> Peek e Extensions)
-> Peeker e (Extensions, Extensions)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair StackIndex -> Peek e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions StackIndex -> Peek e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions StackIndex
idx)
Peek e ExtensionsDiff
-> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
let
[(Extension, Bool)]
exts <- Peeker e Extension -> Peeker e Bool -> Peeker e [(Extension, Bool)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e Extension
forall e. LuaError e => Peeker e Extension
peekExtension Peeker e Bool
forall e. LuaError e => Peeker e Bool
peekEnabled StackIndex
idx
let enabled :: Extensions
enabled = [Extension] -> Extensions
extensionsFromList ([Extension] -> Extensions)
-> ([(Extension, Bool)] -> [Extension])
-> [(Extension, Bool)]
-> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Extension, Bool) -> Extension)
-> [(Extension, Bool)] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (Extension, Bool) -> Extension
forall a b. (a, b) -> a
fst ([(Extension, Bool)] -> Extensions)
-> [(Extension, Bool)] -> Extensions
forall a b. (a -> b) -> a -> b
$ ((Extension, Bool) -> Bool)
-> [(Extension, Bool)] -> [(Extension, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Extension, Bool)]
exts
let disabled :: Extensions
disabled = [Extension] -> Extensions
extensionsFromList ([Extension] -> Extensions)
-> ([(Extension, Bool)] -> [Extension])
-> [(Extension, Bool)]
-> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Extension, Bool) -> Extension)
-> [(Extension, Bool)] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (Extension, Bool) -> Extension
forall a b. (a, b) -> a
fst ([(Extension, Bool)] -> Extensions)
-> [(Extension, Bool)] -> Extensions
forall a b. (a -> b) -> a -> b
$ ((Extension, Bool) -> Bool)
-> [(Extension, Bool)] -> [(Extension, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Extension, Bool) -> Bool) -> (Extension, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension, Bool) -> Bool
forall a b. (a, b) -> b
snd) [(Extension, Bool)]
exts
ExtensionsDiff -> Peek e ExtensionsDiff
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionsDiff -> Peek e ExtensionsDiff)
-> ExtensionsDiff -> Peek e ExtensionsDiff
forall a b. (a -> b) -> a -> b
$ Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff Extensions
enabled Extensions
disabled)
peekEnabled :: LuaError e => Peeker e Bool
peekEnabled :: Peeker e Bool
peekEnabled StackIndex
idx' = 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 StackIndex
idx') Peek e Type -> (Type -> Peek e Bool) -> Peek e Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeBoolean -> Peeker e Bool
forall e. Peeker e Bool
peekBool StackIndex
idx'
Type
TypeString -> Peeker e Text
forall e. Peeker e Text
peekText StackIndex
idx' Peek e Text -> (Text -> Peek e Bool) -> Peek e Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Text
"disable" -> Bool -> Peek e Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Text
"enable" -> Bool -> Peek e Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Text
_ -> ByteString -> Peek e Bool
forall a e. ByteString -> Peek e a
failPeek ByteString
"expected 'disable' or 'enable'"
Type
_ -> ByteString -> Peek e Bool
forall a e. ByteString -> Peek e a
failPeek ByteString
"expected boolean or string"
peekFlavoredFormat :: Peeker PandocError FlavoredFormat
peekFlavoredFormat :: Peeker PandocError FlavoredFormat
peekFlavoredFormat StackIndex
idx = Name
-> Peek PandocError FlavoredFormat
-> Peek PandocError FlavoredFormat
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"flavored format" (Peek PandocError FlavoredFormat
-> Peek PandocError FlavoredFormat)
-> Peek PandocError FlavoredFormat
-> Peek PandocError FlavoredFormat
forall a b. (a -> b) -> a -> b
$
LuaE PandocError Type -> Peek PandocError Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE PandocError Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek PandocError Type
-> (Type -> Peek PandocError FlavoredFormat)
-> Peek PandocError FlavoredFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeString -> Peeker PandocError Text
forall e. Peeker e Text
peekText StackIndex
idx Peek PandocError Text
-> (Text -> Peek PandocError FlavoredFormat)
-> Peek PandocError FlavoredFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LuaE PandocError FlavoredFormat -> Peek PandocError FlavoredFormat
forall e a. LuaE e a -> Peek e a
liftLua (LuaE PandocError FlavoredFormat
-> Peek PandocError FlavoredFormat)
-> (Text -> LuaE PandocError FlavoredFormat)
-> Text
-> Peek PandocError FlavoredFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocLua FlavoredFormat -> LuaE PandocError FlavoredFormat
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua FlavoredFormat -> LuaE PandocError FlavoredFormat)
-> (Text -> PandocLua FlavoredFormat)
-> Text
-> LuaE PandocError FlavoredFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocLua FlavoredFormat
forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
parseFlavoredFormat
Type
TypeTable -> do
let diffFor :: Text -> StackIndex -> Peek e ExtensionsDiff
diffFor Text
format StackIndex
idx' = StackIndex -> Peek e ExtensionsDiff
forall e. LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff StackIndex
idx' Peek e ExtensionsDiff
-> Peek e ExtensionsDiff -> Peek e ExtensionsDiff
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Extensions
getDefaultExtensions Text
format Extensions -> Extensions -> ExtensionsDiff
`diffExtensions`) (Extensions -> ExtensionsDiff)
-> Peek e Extensions -> Peek e ExtensionsDiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e Extensions
-> Peeker e Extensions
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable Peeker e Extensions
forall e. LuaError e => Peeker e Extensions
peekExtensions StackIndex
idx')
Text
format <- Peeker PandocError Text -> Name -> Peeker PandocError Text
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker PandocError Text
forall e. Peeker e Text
peekText Name
"format" StackIndex
idx
ExtensionsDiff
extsDiff <- Peeker PandocError ExtensionsDiff
-> Name -> Peeker PandocError ExtensionsDiff
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peeker PandocError ExtensionsDiff
-> Peeker PandocError ExtensionsDiff
forall a e. Monoid a => Peeker e a -> Peeker e a
emptyOr (Text -> Peeker PandocError ExtensionsDiff
forall e. LuaError e => Text -> StackIndex -> Peek e ExtensionsDiff
diffFor Text
format)) Name
"extensions" StackIndex
idx
FlavoredFormat -> Peek PandocError FlavoredFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
format ExtensionsDiff
extsDiff)
Type
_ -> ByteString -> Peek PandocError FlavoredFormat
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek PandocError FlavoredFormat)
-> Peek PandocError ByteString -> Peek PandocError FlavoredFormat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> StackIndex -> Peek PandocError ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"string or table" StackIndex
idx
emptyOr :: Monoid a => Peeker e a -> Peeker e a
emptyOr :: Peeker e a -> Peeker e a
emptyOr Peeker e a
p StackIndex
idx = do
Bool
nil <- 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
isnil StackIndex
idx)
if Bool
nil
then a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
else Peeker e a
p StackIndex
idx