{-|
Module      : HsLua.Module.SystemUtils
Copyright   : © 2019-2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>

Utility functions and types for HsLua's system module.
-}
module HsLua.Module.SystemUtils
  ( Callback (..)
  , peekCallback
  , invoke
  , invokeWithFilePath
  , ioToLua
  )
where

import Control.Exception (IOException, try)
import HsLua.Core hiding (try)
import HsLua.Marshalling

-- | Lua callback function. This type is similar to @'AnyValue'@, and
-- the same caveats apply.
newtype Callback = Callback StackIndex

peekCallback :: Peeker e Callback
peekCallback :: Peeker e Callback
peekCallback = Name
-> (StackIndex -> LuaE e (Maybe Callback)) -> Peeker e Callback
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"function" ((StackIndex -> LuaE e (Maybe Callback)) -> Peeker e Callback)
-> (StackIndex -> LuaE e (Maybe Callback)) -> Peeker e Callback
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  Bool
isFn <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isfunction StackIndex
idx'
  Maybe Callback -> LuaE e (Maybe Callback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Callback -> LuaE e (Maybe Callback))
-> Maybe Callback -> LuaE e (Maybe Callback)
forall a b. (a -> b) -> a -> b
$ if Bool
isFn
           then Callback -> Maybe Callback
forall a. a -> Maybe a
Just (Callback -> Maybe Callback) -> Callback -> Maybe Callback
forall a b. (a -> b) -> a -> b
$ StackIndex -> Callback
Callback StackIndex
idx'
           else Maybe Callback
forall a. Maybe a
Nothing

pushCallback :: Pusher e Callback
pushCallback :: Pusher e Callback
pushCallback (Callback StackIndex
idx) = StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx

-- | Call Lua callback function and return all of its results.
invoke :: LuaError e
       => Callback -> LuaE e NumResults
invoke :: Callback -> LuaE e NumResults
invoke Callback
callback = do
  StackIndex
oldTop <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
  Pusher e Callback
forall e. Pusher e Callback
pushCallback Callback
callback
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call NumArgs
0 NumResults
multret
  StackIndex
newTop <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
  NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> LuaE e NumResults)
-> (StackIndex -> NumResults) -> StackIndex -> LuaE e NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> NumResults
NumResults (CInt -> NumResults)
-> (StackIndex -> CInt) -> StackIndex -> NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex (StackIndex -> LuaE e NumResults)
-> StackIndex -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$
    StackIndex
newTop StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
- StackIndex
oldTop

-- | Call Lua callback function with the given filename as its argument.
invokeWithFilePath :: LuaError e
                   => Callback -> FilePath -> LuaE e NumResults
invokeWithFilePath :: Callback -> FilePath -> LuaE e NumResults
invokeWithFilePath Callback
callback FilePath
filename = do
  StackIndex
oldTop <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
  Pusher e Callback
forall e. Pusher e Callback
pushCallback Callback
callback
  FilePath -> LuaE e ()
forall e. FilePath -> LuaE e ()
pushString FilePath
filename
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call (CInt -> NumArgs
NumArgs CInt
1) NumResults
multret
  StackIndex
newTop <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
  NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> LuaE e NumResults)
-> (StackIndex -> NumResults) -> StackIndex -> LuaE e NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> NumResults
NumResults (CInt -> NumResults)
-> (StackIndex -> CInt) -> StackIndex -> NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex (StackIndex -> LuaE e NumResults)
-> StackIndex -> LuaE e NumResults
forall a b. (a -> b) -> a -> b
$
    StackIndex
newTop StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
- StackIndex
oldTop

-- | Convert a System IO operation to a Lua operation.
ioToLua :: LuaError e => IO a -> LuaE e a
ioToLua :: IO a -> LuaE e a
ioToLua IO a
action = do
  Either IOException a
result <- IO (Either IOException a) -> LuaE e (Either IOException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action)
  case Either IOException a
result of
    Right a
result' -> a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result'
    Left IOException
err      -> FilePath -> LuaE e a
forall e a. LuaError e => FilePath -> LuaE e a
failLua (IOException -> FilePath
forall a. Show a => a -> FilePath
show (IOException
err :: IOException))