{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{- |
   Module      : Text.Pandoc.Lua.Marshal.PandocError
   Copyright   : © 2020-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

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

Marshal of @'PandocError'@ values.
-}
module Text.Pandoc.Lua.Marshal.PandocError
  ( peekPandocError
  , pushPandocError
  , typePandocError
  )
  where

import HsLua (LuaError, Peeker, Pusher, liftLua, pushString)
import HsLua.Packaging
import Text.Pandoc.Error (PandocError (PandocLuaError))

import qualified HsLua as Lua
import qualified Text.Pandoc.UTF8 as UTF8

-- | Lua userdata type definition for PandocError.
typePandocError :: LuaError e => DocumentedType e PandocError
typePandocError :: forall e. LuaError e => DocumentedType e PandocError
typePandocError = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"PandocError"
  [ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Tostring forall a b. (a -> b) -> a -> b
$ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"__tostring"
    ### liftPure (show @PandocError)
    forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e PandocError
typePandocError Text
"obj" Text
"PandocError object"
    forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. String -> LuaE e ()
pushString Text
"string" Text
"string representation of error."
  ]
  forall a. Monoid a => a
mempty -- no members

-- | Peek a @'PandocError'@ element to the Lua stack.
pushPandocError :: LuaError e => Pusher e PandocError
pushPandocError :: forall e. LuaError e => Pusher e PandocError
pushPandocError = forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e PandocError
typePandocError

-- | Retrieve a @'PandocError'@ from the Lua stack.
peekPandocError :: LuaError e => Peeker e PandocError
peekPandocError :: forall e. LuaError e => Peeker e PandocError
peekPandocError StackIndex
idx = forall e a. Name -> Peek e a -> Peek e a
Lua.retrieving Name
"PandocError" forall a b. (a -> b) -> a -> b
$
  forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
Lua.ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
Lua.TypeUserdata -> forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e PandocError
typePandocError StackIndex
idx
    Type
_ -> do
      ByteString
msg <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaE e State
Lua.state forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \State
l -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (State -> IO ByteString
Lua.popErrorMessage State
l)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (ByteString -> Text
UTF8.toText ByteString
msg)