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

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

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

import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Error (PandocError (PandocLuaError))

import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Userdata as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
import qualified Text.Pandoc.UTF8 as UTF8

-- | Userdata name used by Lua for the @PandocError@ type.
pandocErrorName :: String
pandocErrorName :: String
pandocErrorName = String
"pandoc error"

-- | Peek a @'PandocError'@ element to the Lua stack.
pushPandocError :: PandocError -> Lua ()
pushPandocError :: PandocError -> Lua ()
pushPandocError = Lua () -> PandocError -> Lua ()
forall a. Lua () -> a -> Lua ()
Lua.pushAnyWithMetatable Lua ()
pushPandocErrorMT
  where
    pushPandocErrorMT :: Lua ()
pushPandocErrorMT = String -> Lua () -> Lua ()
Lua.ensureUserdataMetatable String
pandocErrorName (Lua () -> Lua ()) -> Lua () -> Lua ()
forall a b. (a -> b) -> a -> b
$
      String -> (PandocError -> Lua String) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
LuaUtil.addFunction String
"__tostring" PandocError -> Lua String
__tostring

-- | Retrieve a @'PandocError'@ from the Lua stack.
peekPandocError :: StackIndex -> Lua PandocError
peekPandocError :: StackIndex -> Lua PandocError
peekPandocError StackIndex
idx = StackIndex -> Lua Type
Lua.ltype StackIndex
idx Lua Type -> (Type -> Lua PandocError) -> Lua PandocError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeUserdata -> do
    Maybe PandocError
errMb <- StackIndex -> String -> Lua (Maybe PandocError)
forall a. StackIndex -> String -> Lua (Maybe a)
Lua.toAnyWithName StackIndex
idx String
pandocErrorName
    PandocError -> Lua PandocError
forall (m :: * -> *) a. Monad m => a -> m a
return (PandocError -> Lua PandocError) -> PandocError -> Lua PandocError
forall a b. (a -> b) -> a -> b
$ case Maybe PandocError
errMb of
      Just PandocError
err -> PandocError
err
      Maybe PandocError
Nothing  -> Text -> PandocError
PandocLuaError Text
"could not retrieve original error"
  Type
_ -> do
    StackIndex -> Lua ()
Lua.pushvalue StackIndex
idx
    ByteString
msg <- Lua State
Lua.state Lua State -> (State -> Lua ByteString) -> Lua ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \State
l -> IO ByteString -> Lua ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (State -> IO ByteString
Lua.errorMessage State
l)
    PandocError -> Lua PandocError
forall (m :: * -> *) a. Monad m => a -> m a
return (PandocError -> Lua PandocError) -> PandocError -> Lua PandocError
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (ByteString -> Text
UTF8.toText ByteString
msg)

-- | Convert to string.
__tostring :: PandocError -> Lua String
__tostring :: PandocError -> Lua String
__tostring = String -> Lua String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lua String)
-> (PandocError -> String) -> PandocError -> Lua String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> String
forall a. Show a => a -> String
show

--
-- Instances
--

instance Pushable PandocError where
  push :: PandocError -> Lua ()
push = PandocError -> Lua ()
pushPandocError

instance Peekable PandocError where
  peek :: StackIndex -> Lua PandocError
peek = StackIndex -> Lua PandocError
peekPandocError