1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.Marshaling.Format
Copyright : © 2022-2024 Albert Krewinkel
License : GPL-2.0-or-later
Maintainer : Albert Krewinkel <[email protected]>
Marshaling functions and instance for format related types, including
'Extensions' and 'ExtensionConfig'.
-}
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))
-- | Retrieves a single 'Extension' from the Lua stack.
peekExtension :: LuaError e => Peeker e Extension
peekExtension idx = do
extString <- peekString idx
return $ readExtension extString
{-# INLINE peekExtension #-}
-- | Pushes an individual 'Extension' to the Lua stack.
pushExtension :: LuaError e => Pusher e Extension
pushExtension = pushText . showExtension
{-# INLINE pushExtension #-}
-- | Retrieves an 'Extensions' set from the Lua stack.
peekExtensions :: LuaError e => Peeker e Extensions
peekExtensions = fmap extensionsFromList . peekList peekExtension
{-# INLINE peekExtensions #-}
-- | Pushes a set of 'Extensions' to the top of the Lua stack.
pushExtensions :: LuaError e => Pusher e Extensions
pushExtensions = pushViaJSON
{-# INLINE pushExtensions #-}
instance Peekable Extensions where
safepeek = peekExtensions
instance Pushable Extensions where
push = pushExtensions
-- | Retrieves an 'ExtensionsConfig' value from the Lua stack.
peekExtensionsConfig :: LuaError e => Peeker e ExtensionsConfig
peekExtensionsConfig idx = do
diff <- peekExtensionsDiff idx
return $ ExtensionsConfig
{ extsDefault = extsToEnable diff
, extsSupported = extsToEnable diff <> extsToDisable diff
}
-- | Pushes an 'ExtensionsConfig' value as a table with that maps
-- extensions to their default enabled/disabled status.
pushExtensionsConfig :: LuaError e => Pusher e ExtensionsConfig
pushExtensionsConfig (ExtensionsConfig def supported) =
pushKeyValuePairs pushExtension pushBool $
map (,False) (extensionsToList supported) ++
map (,True) (extensionsToList def)
instance Peekable ExtensionsConfig where
safepeek = peekExtensionsConfig
peekExtensionsDiff :: LuaError e => Peeker e ExtensionsDiff
peekExtensionsDiff = typeChecked "table" istable $ \idx ->
(do
en <- peekFieldRaw (emptyOr (fmap Just . peekExtensions)) "enable" idx
di <- peekFieldRaw (emptyOr (fmap Just . peekExtensions)) "disable" idx
if (en, di) == (Nothing, Nothing)
then failPeek "At least on of 'enable' and 'disable' must be set"
else return $
ExtensionsDiff (fromMaybe mempty en) (fromMaybe mempty di))
<|> -- two lists of extensions; the first is list assumed to contain those
-- extensions to be enabled
(uncurry ExtensionsDiff <$!> peekPair peekExtensions peekExtensions idx)
<|> (do
let
exts <- peekKeyValuePairs peekExtension peekEnabled idx
let enabled = extensionsFromList . map fst $ filter snd exts
let disabled = extensionsFromList . map fst $ filter (not . snd) exts
return $ ExtensionsDiff enabled disabled)
-- | Retrieves the activation status of an extension. True or the string
-- @'enable'@ for activated, False or 'disable' for disabled.
peekEnabled :: LuaError e => Peeker e Bool
peekEnabled idx' = liftLua (ltype idx') >>= \case
TypeBoolean -> peekBool idx'
TypeString -> peekText idx' >>= \case
"disable" -> pure False
"enable" -> pure True
_ -> failPeek "expected 'disable' or 'enable'"
_ -> failPeek "expected boolean or string"
-- | Retrieves a flavored format from the Lua stack.
peekFlavoredFormat :: Peeker PandocError FlavoredFormat
peekFlavoredFormat idx = retrieving "flavored format" $
liftLua (ltype idx) >>= \case
TypeString -> peekText idx >>= liftLua . unPandocLua . parseFlavoredFormat
TypeTable -> do
let diffFor format idx' = peekExtensionsDiff idx' <|>
(getDefaultExtensions format `diffExtensions`) <$>
(typeChecked "table" istable peekExtensions idx')
format <- peekFieldRaw peekText "format" idx
extsDiff <- peekFieldRaw (emptyOr (diffFor format)) "extensions" idx
return (FlavoredFormat format extsDiff)
_ -> failPeek =<< typeMismatchMessage "string or table" idx
-- | Returns 'mempty' if the given stack index is @nil@, and the result
-- of the peeker otherwise.
emptyOr :: Monoid a => Peeker e a -> Peeker e a
emptyOr p idx = do
nil <- liftLua (isnil idx)
if nil
then pure mempty
else p idx
|
