{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.Marshaling.ReaderOptions
   Copyright   : © 2012-2021 John MacFarlane
                 © 2017-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Marshaling instance for ReaderOptions and its components.
-}
module Text.Pandoc.Lua.Marshaling.ReaderOptions
  ( peekReaderOptions
  , pushReaderOptions
  , pushReaderOptionsReadonly
  ) where

import Data.Default (def)
import HsLua as Lua
import Text.Pandoc.Lua.Marshaling.List (pushPandocList)
import Text.Pandoc.Options (ReaderOptions (..))

--
-- Reader Options
--

-- | Retrieve a ReaderOptions value, either from a normal ReaderOptions
-- value, from a read-only object, or from a table with the same
-- keys as a ReaderOptions object.
peekReaderOptions :: LuaError e => Peeker e ReaderOptions
peekReaderOptions :: Peeker e ReaderOptions
peekReaderOptions = Name -> Peek e ReaderOptions -> Peek e ReaderOptions
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ReaderOptions" (Peek e ReaderOptions -> Peek e ReaderOptions)
-> Peeker e ReaderOptions -> Peeker e ReaderOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \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 ReaderOptions) -> Peek e ReaderOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeUserdata -> [Peeker e ReaderOptions] -> Peeker e ReaderOptions
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [ 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
                           , 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
typeReaderOptionsReadonly
                           ]
                           StackIndex
idx
    Type
TypeTable    -> Peeker e ReaderOptions
forall e. LuaError e => Peeker e ReaderOptions
peekReaderOptionsTable StackIndex
idx
    Type
_            -> ByteString -> Peek e ReaderOptions
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e ReaderOptions)
-> Peek e ByteString -> Peek e ReaderOptions
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"ReaderOptions userdata or table" StackIndex
idx

-- | Pushes a ReaderOptions value as userdata object.
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

-- | Pushes a ReaderOptions object, but makes it read-only.
pushReaderOptionsReadonly :: LuaError e => Pusher e ReaderOptions
pushReaderOptionsReadonly :: Pusher e ReaderOptions
pushReaderOptionsReadonly = 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
typeReaderOptionsReadonly

-- | ReaderOptions object type for read-only values.
typeReaderOptionsReadonly :: LuaError e => DocumentedType e ReaderOptions
typeReaderOptionsReadonly :: DocumentedType e ReaderOptions
typeReaderOptionsReadonly = 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
"ReaderOptions (read-only)"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (ReaderOptions -> LuaE e String)
-> HsFnPrecursor e (ReaderOptions -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### 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
<#> DocumentedType e ReaderOptions
-> Text -> Text -> Parameter e ReaderOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e ReaderOptions
forall e. LuaError e => DocumentedType e ReaderOptions
typeReaderOptions Text
"opts" Text
"options 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"
  , Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Newindex (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ LuaE e NumResults -> HsFnPrecursor e (LuaE e NumResults)
forall a e. a -> HsFnPrecursor e a
lambda
    ### (failLua "This ReaderOptions value is read-only.")
    HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"Throws an error when called, i.e., an assignment is made."
  ]
  [Member e (DocumentedFunction e) ReaderOptions]
forall e.
LuaError e =>
[Member e (DocumentedFunction e) ReaderOptions]
readerOptionsMembers

-- | 'ReaderOptions' object type.
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
"ReaderOptions"
  [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ (ReaderOptions -> LuaE e String)
-> HsFnPrecursor e (ReaderOptions -> LuaE e String)
forall a e. a -> HsFnPrecursor e a
lambda
    ### 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
<#> DocumentedType e ReaderOptions
-> Text -> Text -> Parameter e ReaderOptions
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedType e ReaderOptions
forall e. LuaError e => DocumentedType e ReaderOptions
typeReaderOptions Text
"opts" Text
"options 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"
  ]
  [Member e (DocumentedFunction e) ReaderOptions]
forall e.
LuaError e =>
[Member e (DocumentedFunction e) ReaderOptions]
readerOptionsMembers

-- | Member properties of 'ReaderOptions' Lua values.
readerOptionsMembers :: LuaError e
                     => [Member e (DocumentedFunction e) ReaderOptions]
readerOptionsMembers :: [Member e (DocumentedFunction e) ReaderOptions]
readerOptionsMembers =
  [ Name
-> Text
-> (Pusher e (Set Text), ReaderOptions -> Set Text)
-> (Peeker e (Set Text),
    ReaderOptions -> Set Text -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property 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)
      (Peeker e Text -> Peeker e (Set Text)
forall a e. Ord a => Peeker e a -> Peeker e (Set a)
peekSet Peeker e Text
forall e. Peeker e Text
peekText, \ReaderOptions
opts Set Text
x -> ReaderOptions
opts{ readerAbbreviations :: Set Text
readerAbbreviations = Set Text
x })
  , Name
-> Text
-> (Pusher e Int, ReaderOptions -> Int)
-> (Peeker e Int, ReaderOptions -> Int -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"columns" Text
""
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, ReaderOptions -> Int
readerColumns)
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \ReaderOptions
opts Int
x -> ReaderOptions
opts{ readerColumns :: Int
readerColumns = Int
x })
  , Name
-> Text
-> (Pusher e Text, ReaderOptions -> Text)
-> (Peeker e Text, ReaderOptions -> Text -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"default_image_extension" Text
""
      (Pusher e Text
forall e. Pusher e Text
pushText, ReaderOptions -> Text
readerDefaultImageExtension)
      (Peeker e Text
forall e. Peeker e Text
peekText, \ReaderOptions
opts Text
x -> ReaderOptions
opts{ readerDefaultImageExtension :: Text
readerDefaultImageExtension = Text
x })
  , Name
-> Text
-> (Pusher e Extensions, ReaderOptions -> Extensions)
-> (Peeker e Extensions,
    ReaderOptions -> Extensions -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property 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)
      (Peeker e Extensions
forall a e. Read a => Peeker e a
peekRead, \ReaderOptions
opts Extensions
x -> ReaderOptions
opts{ readerExtensions :: Extensions
readerExtensions = Extensions
x })
  , Name
-> Text
-> (Pusher e [Text], ReaderOptions -> [Text])
-> (Peeker e [Text], ReaderOptions -> [Text] -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property 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)
      (Peeker e Text -> Peeker e [Text]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Text
forall e. Peeker e Text
peekText, \ReaderOptions
opts [Text]
x -> ReaderOptions
opts{ readerIndentedCodeClasses :: [Text]
readerIndentedCodeClasses = [Text]
x })
  , Name
-> Text
-> (Pusher e Bool, ReaderOptions -> Bool)
-> (Peeker e Bool, ReaderOptions -> Bool -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"strip_comments" Text
""
      (Pusher e Bool
forall e. Pusher e Bool
pushBool, ReaderOptions -> Bool
readerStripComments)
      (Peeker e Bool
forall e. Peeker e Bool
peekBool, \ReaderOptions
opts Bool
x -> ReaderOptions
opts{ readerStripComments :: Bool
readerStripComments = Bool
x })
  , Name
-> Text
-> (Pusher e Bool, ReaderOptions -> Bool)
-> (Peeker e Bool, ReaderOptions -> Bool -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"standalone" Text
""
      (Pusher e Bool
forall e. Pusher e Bool
pushBool, ReaderOptions -> Bool
readerStandalone)
      (Peeker e Bool
forall e. Peeker e Bool
peekBool, \ReaderOptions
opts Bool
x -> ReaderOptions
opts{ readerStandalone :: Bool
readerStandalone = Bool
x })
  , Name
-> Text
-> (Pusher e Int, ReaderOptions -> Int)
-> (Peeker e Int, ReaderOptions -> Int -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"tab_stop" Text
""
      (Pusher e Int
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, ReaderOptions -> Int
readerTabStop)
      (Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \ReaderOptions
opts Int
x -> ReaderOptions
opts{ readerTabStop :: Int
readerTabStop = Int
x })
  , Name
-> Text
-> (Pusher e TrackChanges, ReaderOptions -> TrackChanges)
-> (Peeker e TrackChanges,
    ReaderOptions -> TrackChanges -> ReaderOptions)
-> Member e (DocumentedFunction e) ReaderOptions
forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property 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)
      (Peeker e TrackChanges
forall a e. Read a => Peeker e a
peekRead, \ReaderOptions
opts TrackChanges
x -> ReaderOptions
opts{ readerTrackChanges :: TrackChanges
readerTrackChanges = TrackChanges
x })
  ]

-- | Retrieves a 'ReaderOptions' object from a table on the stack, using
-- the default values for all missing fields.
--
-- Internally, this pushes the default reader options, sets each
-- key/value pair of the table in the userdata value, then retrieves the
-- object again. This will update all fields and complain about unknown
-- keys.
peekReaderOptionsTable :: LuaError e => Peeker e ReaderOptions
peekReaderOptionsTable :: Peeker e ReaderOptions
peekReaderOptionsTable StackIndex
idx = Name -> Peek e ReaderOptions -> Peek e ReaderOptions
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ReaderOptions (table)" (Peek e ReaderOptions -> Peek e ReaderOptions)
-> Peek e ReaderOptions -> Peek e ReaderOptions
forall a b. (a -> b) -> a -> b
$ do
  LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ do
    StackIndex
absidx <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
    UDTypeWithList e (DocumentedFunction e) ReaderOptions Void
-> ReaderOptions -> LuaE e ()
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 ReaderOptions
forall a. Default a => a
def
    let setFields :: LuaE e ()
setFields = do
          StackIndex -> LuaE e Bool
forall e. LuaError e => StackIndex -> LuaE e Bool
next StackIndex
absidx LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- all fields were copied
            Bool
True -> do
              StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) LuaE e () -> LuaE e () -> LuaE e ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
insert (CInt -> StackIndex
nth CInt
2)
              StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
settable (CInt -> StackIndex
nth CInt
4) -- set in userdata object
              LuaE e ()
setFields
    LuaE e ()
forall e. LuaE e ()
pushnil -- first key
    LuaE e ()
setFields
  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 StackIndex
top

instance Pushable ReaderOptions where
  push :: ReaderOptions -> LuaE e ()
push = ReaderOptions -> LuaE e ()
forall e. LuaError e => ReaderOptions -> LuaE e ()
pushReaderOptions