{-|
Module      : Foreign.Lua.Module.SystemUtils
Copyright   : © 2019-2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>
Stability   : alpha
Portability : Requires GHC 8 or later.

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

import Control.Exception (IOException, try)
import Foreign.Lua (Lua, NumResults(..), Peekable, Pushable, StackIndex)
import qualified Foreign.Lua as Lua

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

instance Peekable Callback where
  peek :: StackIndex -> Lua Callback
peek StackIndex
idx = do
    Bool
isFn <- StackIndex -> Lua Bool
Lua.isfunction StackIndex
idx
    if Bool
isFn
      then Callback -> Lua Callback
forall (m :: * -> *) a. Monad m => a -> m a
return (StackIndex -> Callback
Callback StackIndex
idx)
      else String -> Lua Callback
forall a. String -> Lua a
Lua.throwException String
"Function expected"

instance Pushable Callback where
  push :: Callback -> Lua ()
push (Callback StackIndex
idx) = StackIndex -> Lua ()
Lua.pushvalue StackIndex
idx


-- | Any value of unknown type.
--
-- This simply wraps the function's index on the Lua stack. Changes to
-- the stack may only be made with great care, as they can break the
-- reference.
newtype AnyValue = AnyValue { AnyValue -> StackIndex
fromAnyValue :: StackIndex }

instance Peekable AnyValue where
  peek :: StackIndex -> Lua AnyValue
peek = AnyValue -> Lua AnyValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyValue -> Lua AnyValue)
-> (StackIndex -> AnyValue) -> StackIndex -> Lua AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> AnyValue
AnyValue

instance Pushable AnyValue where
  push :: AnyValue -> Lua ()
push (AnyValue StackIndex
idx) = StackIndex -> Lua ()
Lua.pushvalue StackIndex
idx

-- | Call Lua callback function and return all of its results.
invoke :: Callback -> Lua NumResults
invoke :: Callback -> Lua NumResults
invoke Callback
callback = do
  StackIndex
oldTop <- Lua StackIndex
Lua.gettop
  Callback -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Callback
callback
  NumArgs -> NumResults -> Lua ()
Lua.call NumArgs
0 NumResults
Lua.multret
  StackIndex
newTop <- Lua StackIndex
Lua.gettop
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> Lua NumResults)
-> (StackIndex -> NumResults) -> StackIndex -> Lua 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
. CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> CInt) -> (StackIndex -> CInt) -> StackIndex -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
Lua.fromStackIndex (StackIndex -> Lua NumResults) -> StackIndex -> Lua 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 :: Callback -> FilePath -> Lua NumResults
invokeWithFilePath :: Callback -> String -> Lua NumResults
invokeWithFilePath Callback
callback String
filename = do
  StackIndex
oldTop <- Lua StackIndex
Lua.gettop
  Callback -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push Callback
callback
  String -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push String
filename
  NumArgs -> NumResults -> Lua ()
Lua.call (CInt -> NumArgs
Lua.NumArgs CInt
1) NumResults
Lua.multret
  StackIndex
newTop <- Lua StackIndex
Lua.gettop
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (NumResults -> Lua NumResults)
-> (StackIndex -> NumResults) -> StackIndex -> Lua 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
. CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> CInt) -> (StackIndex -> CInt) -> StackIndex -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
Lua.fromStackIndex (StackIndex -> Lua NumResults) -> StackIndex -> Lua 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 :: IO a -> Lua a
ioToLua :: IO a -> Lua a
ioToLua IO a
action = do
  Either IOException a
result <- IO (Either IOException a) -> Lua (Either IOException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.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 -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result'
    Left IOException
err      -> String -> Lua a
forall a. String -> Lua a
Lua.throwException (IOException -> String
forall a. Show a => a -> String
show (IOException
err :: IOException))