{-# LANGUAGE LambdaCase #-}

module Oughta.Exception
  ( Exception(..)
  , NoMatch
  , noMatch
  , throwNoMatch
  ) where

import Control.Exception qualified as X
import Control.Monad.Catch qualified as Catch
import Control.Monad.IO.Class (liftIO)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Oughta.Result qualified as OR
import Foreign.StablePtr (StablePtr)
import Foreign.StablePtr qualified as Foreign
import HsLua qualified as Lua
import HsLua.Core.Utf8 qualified as Lua.Utf8

-- | Exceptions that may be thrown from Lua code.
--
-- Must be storable on the Lua stack. Uses opaque 'Ptr's for data that cannot be
-- inspected by Lua.
data Exception
  = LuaException Lua.Exception
    -- | @fail@ was called.
  | Failure NoMatch

-- | Wrapper for 'OR.Failure'
newtype NoMatch = NoMatch (StablePtr OR.Failure)

instance Show NoMatch where
  -- can't do IO here, but this Show instance won't be used anyway
  show :: NoMatch -> String
show (NoMatch {}) = String
"oughta: no match"

instance Show Exception where
  show :: Exception -> String
show =
    \case
      LuaException Exception
e -> Exception -> String
forall a. Show a => a -> String
show Exception
e
      Failure NoMatch
f -> NoMatch -> String
forall a. Show a => a -> String
show NoMatch
f

instance X.Exception Exception

noMatch :: NoMatch -> IO OR.Failure
noMatch :: NoMatch -> IO Failure
noMatch (NoMatch StablePtr Failure
sp) = StablePtr Failure -> IO Failure
forall a. StablePtr a -> IO a
Foreign.deRefStablePtr StablePtr Failure
sp

throwNoMatch :: OR.Failure -> Lua.LuaE Exception a
throwNoMatch :: forall a. Failure -> LuaE Exception a
throwNoMatch Failure
failure = do
  StablePtr Failure
sp <- IO (StablePtr Failure) -> LuaE Exception (StablePtr Failure)
forall a. IO a -> LuaE Exception a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Failure -> IO (StablePtr Failure)
forall a. a -> IO (StablePtr a)
Foreign.newStablePtr Failure
failure)
  Exception -> LuaE Exception a
forall e a. (HasCallStack, Exception e) => e -> LuaE Exception a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Catch.throwM (NoMatch -> Exception
Failure (StablePtr Failure -> NoMatch
NoMatch StablePtr Failure
sp))

instance Lua.LuaError Exception where
  popException :: LuaE Exception Exception
popException = do
    Maybe ByteString
top <- StackIndex -> LuaE Exception (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
Lua.tostring StackIndex
Lua.top
    case Maybe ByteString
top of
      Just ByteString
str -> do
        Int -> LuaE Exception ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
        Exception -> LuaE Exception Exception
forall a. a -> LuaE Exception a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exception -> Exception
LuaException (String -> Exception
Lua.Exception (Text -> String
Text.unpack (ByteString -> Text
Text.decodeUtf8Lenient ByteString
str))))
      Maybe ByteString
Nothing -> do
        Maybe (Ptr ())
top' <- StackIndex -> LuaE Exception (Maybe (Ptr ()))
forall e a. StackIndex -> LuaE e (Maybe (Ptr a))
Lua.touserdata StackIndex
Lua.top
        case Maybe (Ptr ())
top' of
          Just Ptr ()
ptr -> do
            Int -> LuaE Exception ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
            Exception -> LuaE Exception Exception
forall a. a -> LuaE Exception a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoMatch -> Exception
Failure (StablePtr Failure -> NoMatch
NoMatch (Ptr () -> StablePtr Failure
forall a. Ptr () -> StablePtr a
Foreign.castPtrToStablePtr Ptr ()
ptr)))
          Maybe (Ptr ())
Nothing -> String -> LuaE Exception Exception
forall e a. LuaError e => String -> LuaE e a
Lua.failLua String
"Bad exception!"

  pushException :: Exception -> LuaE Exception ()
pushException =
    \case
      LuaException (Lua.Exception String
msg) -> ByteString -> LuaE Exception ()
forall e. ByteString -> LuaE e ()
Lua.pushstring (String -> ByteString
Lua.Utf8.fromString String
msg)
      Failure (NoMatch StablePtr Failure
sp) -> Ptr () -> LuaE Exception ()
forall a e. Ptr a -> LuaE e ()
Lua.pushlightuserdata (StablePtr Failure -> Ptr ()
forall a. StablePtr a -> Ptr ()
Foreign.castStablePtrToPtr StablePtr Failure
sp)

  luaException :: String -> Exception
luaException String
s = Exception -> Exception
LuaException (String -> Exception
forall e. LuaError e => String -> e
Lua.luaException String
s)