{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
   Module      : Text.Pandoc.Lua.ErrorConversion
   Copyright   : © 2020-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

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

Define how Lua errors are converted into @'PandocError'@ Haskell
exceptions, and /vice versa/.
-}
module Text.Pandoc.Lua.ErrorConversion
  ( addContextToException
  ) where

import HsLua (LuaError, LuaE, resultToEither, runPeek, top)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Marshal.PandocError (pushPandocError, peekPandocError)

import qualified Data.Text as T
import qualified HsLua as Lua

addContextToException :: ()
addContextToException :: ()
addContextToException = forall a. HasCallStack => a
undefined

-- | Retrieve a @'PandocError'@ from the Lua stack.
popPandocError :: LuaE PandocError PandocError
popPandocError :: LuaE PandocError PandocError
popPandocError = do
  Result PandocError
errResult <- forall e a. Peek e a -> LuaE e (Result a)
runPeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e PandocError
peekPandocError StackIndex
top
  case forall a. Result a -> Either String a
resultToEither Result PandocError
errResult of
    Right PandocError
x -> forall (m :: * -> *) a. Monad m => a -> m a
return PandocError
x
    Left String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (String -> Text
T.pack String
err)

-- Ensure conversions between Lua errors and 'PandocError' exceptions
-- are possible.
instance LuaError PandocError where
  popException :: LuaE PandocError PandocError
popException = LuaE PandocError PandocError
popPandocError
  pushException :: PandocError -> LuaE PandocError ()
pushException = forall e. LuaError e => Pusher e PandocError
pushPandocError
  luaException :: String -> PandocError
luaException = Text -> PandocError
PandocLuaError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack