{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Lua.ErrorConversion
   Copyright   : © 2020 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
  ( errorConversion
  ) where

import Foreign.Lua (Lua (..), NumResults)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Marshaling.PandocError (pushPandocError, peekPandocError)

import qualified Control.Monad.Catch as Catch
import qualified Data.Text as T
import qualified Foreign.Lua as Lua

-- | Conversions between Lua errors and Haskell exceptions, assuming
-- that all exceptions are of type @'PandocError'@.
errorConversion :: Lua.ErrorConversion
errorConversion :: ErrorConversion
errorConversion = ErrorConversion :: (forall a. State -> IO a)
-> (forall a. String -> Lua a -> Lua a)
-> (forall a. Lua a -> Lua a -> Lua a)
-> (Lua NumResults -> Lua NumResults)
-> ErrorConversion
Lua.ErrorConversion
  { addContextToException :: forall a. String -> Lua a -> Lua a
Lua.addContextToException = forall a. String -> Lua a -> Lua a
addContextToException
  , alternative :: forall a. Lua a -> Lua a -> Lua a
Lua.alternative           = forall a. Lua a -> Lua a -> Lua a
alternative
  , errorToException :: forall a. State -> IO a
Lua.errorToException      = forall a. State -> IO a
errorToException
  , exceptionToError :: Lua NumResults -> Lua NumResults
Lua.exceptionToError      = Lua NumResults -> Lua NumResults
exceptionToError
  }

-- | Convert a Lua error, which must be at the top of the stack, into a
-- @'PandocError'@, popping the value from the stack.
errorToException :: forall a . Lua.State -> IO a
errorToException :: State -> IO a
errorToException State
l = State -> Lua a -> IO a
forall a. State -> Lua a -> IO a
Lua.unsafeRunWith State
l (Lua a -> IO a) -> Lua a -> IO a
forall a b. (a -> b) -> a -> b
$ do
  PandocError
err <- StackIndex -> Lua PandocError
peekPandocError StackIndex
Lua.stackTop
  StackIndex -> Lua ()
Lua.pop StackIndex
1
  PandocError -> Lua a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM PandocError
err

-- | Try the first op -- if it doesn't succeed, run the second.
alternative :: forall a . Lua a -> Lua a -> Lua a
alternative :: Lua a -> Lua a -> Lua a
alternative Lua a
x Lua a
y = Lua a -> Lua (Either PandocError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Catch.try Lua a
x Lua (Either PandocError a)
-> (Either PandocError a -> Lua a) -> Lua a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left (PandocError
_ :: PandocError) -> Lua a
y
  Right a
x' -> a -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x'

-- | Add more context to an error
addContextToException :: forall a . String -> Lua a -> Lua a
addContextToException :: String -> Lua a -> Lua a
addContextToException String
ctx Lua a
op = Lua a
op Lua a -> (PandocError -> Lua a) -> Lua a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Catch.catch` \case
  PandocLuaError Text
msg -> PandocError -> Lua a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM (PandocError -> Lua a) -> PandocError -> Lua a
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocLuaError (String -> Text
T.pack String
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
  PandocError
e -> PandocError -> Lua a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM PandocError
e

-- | Catch a @'PandocError'@ exception and raise it as a Lua error.
exceptionToError :: Lua NumResults -> Lua NumResults
exceptionToError :: Lua NumResults -> Lua NumResults
exceptionToError Lua NumResults
op = Lua NumResults
op Lua NumResults -> (PandocError -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Catch.catch` \PandocError
e -> do
  PandocError -> Lua ()
pushPandocError PandocError
e
  Lua NumResults
Lua.error