{-|
Module      : HsLua.Util
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : non-portable (depends on GHC)

HsLua utility functions.
-}
module HsLua.Util
  ( getglobal'
  , setglobal'
  ) where

import Data.List (groupBy)
import Data.String (IsString (fromString))
import HsLua.Core
  ( LuaE, LuaError (..), Name (..), getfield, getglobal, nth, pop
  , pushvalue, remove, setfield, setglobal, top )
import qualified HsLua.Core.Utf8 as Utf8

-- | Like @getglobal@, but knows about packages and nested tables. E.g.
--
-- > getglobal' "math.sin"
--
-- will return the function @sin@ in package @math@.
getglobal' :: LuaError e => Name -> LuaE e ()
getglobal' :: forall e. LuaError e => Name -> LuaE e ()
getglobal' = forall e. LuaError e => [Name] -> LuaE e ()
getnested forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Name]
splitdot

-- | Like @setglobal@, but knows about packages and nested tables. E.g.
--
-- > pushstring "0.9.4"
-- > setglobal' "mypackage.version"
--
-- All tables and fields, except for the last field, must exist.
setglobal' :: LuaError e => Name -> LuaE e ()
setglobal' :: forall e. LuaError e => Name -> LuaE e ()
setglobal' Name
s =
  case forall a. [a] -> [a]
reverse (Name -> [Name]
splitdot Name
s) of
    [] ->
      forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [Name
_] ->
      forall e. LuaError e => Name -> LuaE e ()
setglobal Name
s
    (Name
lastField : [Name]
xs) -> do
      forall e. LuaError e => [Name] -> LuaE e ()
getnested (forall a. [a] -> [a]
reverse [Name]
xs)
      forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
      forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
lastField
      forall e. Int -> LuaE e ()
pop Int
1

-- | Gives the list of the longest substrings not containing dots.
splitdot :: Name -> [Name]
splitdot :: Name -> [Name]
splitdot = forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
".")
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Char
a Char
b -> Char
a forall a. Eq a => a -> a -> Bool
/= Char
'.' Bool -> Bool -> Bool
&& Char
b forall a. Eq a => a -> a -> Bool
/= Char
'.')
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Utf8.toString
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
fromName

-- | Pushes the value described by the strings to the stack; where the first
-- value is the name of a global variable and the following strings are the
-- field values in nested tables.
getnested :: LuaError e => [Name] -> LuaE e ()
getnested :: forall e. LuaError e => [Name] -> LuaE e ()
getnested [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
getnested (Name
x:[Name]
xs) = do
  Type
_ <- forall e. LuaError e => Name -> LuaE e Type
getglobal Name
x
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Name
a -> forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top Name
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)) [Name]
xs