{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Pandoc.Lua.Marshaling.ReaderOptions
( peekReaderOptions
, pushReaderOptions
) where
import HsLua as Lua
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
import Text.Pandoc.Options (ReaderOptions (..))
peekReaderOptions :: LuaError e => Peeker e ReaderOptions
peekReaderOptions :: Peeker e ReaderOptions
peekReaderOptions = UDTypeWithList e (DocumentedFunction e) ReaderOptions Void
-> Peeker e ReaderOptions
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD UDTypeWithList e (DocumentedFunction e) ReaderOptions Void
forall e. LuaError e => DocumentedType e ReaderOptions
typeReaderOptions
pushReaderOptions :: LuaError e => Pusher e ReaderOptions
pushReaderOptions :: Pusher e ReaderOptions
pushReaderOptions = UDTypeWithList e (DocumentedFunction e) ReaderOptions Void
-> Pusher e ReaderOptions
forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD UDTypeWithList e (DocumentedFunction e) ReaderOptions Void
forall e. LuaError e => DocumentedType e ReaderOptions
typeReaderOptions
typeReaderOptions :: LuaError e => DocumentedType e ReaderOptions
typeReaderOptions :: DocumentedType e ReaderOptions
typeReaderOptions = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) ReaderOptions]
-> DocumentedType e ReaderOptions
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"pandoc ReaderOptions"
[ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
luaShow
]
[ Name
-> Text
-> (Pusher e Extensions, ReaderOptions -> Extensions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"extensions" Text
""
( String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (Extensions -> String) -> Pusher e Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extensions -> String
forall a. Show a => a -> String
show
, ReaderOptions -> Extensions
readerExtensions)
, Name
-> Text
-> (Pusher e Bool, ReaderOptions -> Bool)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"standalone" Text
""
( Pusher e Bool
forall e. Pusher e Bool
pushBool
, ReaderOptions -> Bool
readerStandalone)
, Name
-> Text
-> (Pusher e Int, ReaderOptions -> Int)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"columns" Text
""
( Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral
, ReaderOptions -> Int
readerColumns)
, Name
-> Text
-> (Pusher e Int, ReaderOptions -> Int)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"tab_stop" Text
""
( Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral
, ReaderOptions -> Int
readerTabStop)
, Name
-> Text
-> (Pusher e [Text], ReaderOptions -> [Text])
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"indented_code_classes" Text
""
( Pusher e Text -> Pusher e [Text]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher e Text
forall e. Pusher e Text
pushText
, ReaderOptions -> [Text]
readerIndentedCodeClasses)
, Name
-> Text
-> (Pusher e (Set Text), ReaderOptions -> Set Text)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"abbreviations" Text
""
( Pusher e Text -> Pusher e (Set Text)
forall e a. LuaError e => Pusher e a -> Pusher e (Set a)
pushSet Pusher e Text
forall e. Pusher e Text
pushText
, ReaderOptions -> Set Text
readerAbbreviations)
, Name
-> Text
-> (Pusher e TrackChanges, ReaderOptions -> TrackChanges)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"track_changes" Text
""
( String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (TrackChanges -> String) -> Pusher e TrackChanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackChanges -> String
forall a. Show a => a -> String
show
, ReaderOptions -> TrackChanges
readerTrackChanges)
, Name
-> Text
-> (Pusher e Bool, ReaderOptions -> Bool)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"strip_comments" Text
""
( Pusher e Bool
forall e. Pusher e Bool
pushBool
, ReaderOptions -> Bool
readerStripComments)
, Name
-> Text
-> (Pusher e Text, ReaderOptions -> Text)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
Name -> Text -> (Pusher e b, a -> b) -> Member e fn a
readonly Name
"default_image_extension" Text
""
( Pusher e Text
forall e. Pusher e Text
pushText
, ReaderOptions -> Text
readerDefaultImageExtension)
]
luaShow :: LuaError e => DocumentedFunction e
luaShow :: DocumentedFunction e
luaShow = Name
-> (ReaderOptions -> LuaE e String)
-> HsFnPrecursor e (ReaderOptions -> LuaE e String)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__tostring"
### liftPure show
HsFnPrecursor e (ReaderOptions -> LuaE e String)
-> Parameter e ReaderOptions -> HsFnPrecursor e (LuaE e String)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedTypeWithList e ReaderOptions Void
-> Text -> Text -> Parameter e ReaderOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList e ReaderOptions Void
forall e. LuaError e => DocumentedType e ReaderOptions
typeReaderOptions Text
"state" Text
"object to print in native format"
HsFnPrecursor e (LuaE e String)
-> FunctionResults e String -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e String -> Text -> Text -> FunctionResults e String
forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult Pusher e String
forall e. String -> LuaE e ()
pushString Text
"string" Text
"Haskell representation"