module Foreign.Lua.Module.System (
pushModule
, preloadModule
, arch
, compiler_name
, compiler_version
, os
, env
, getwd
, getenv
, ls
, mkdir
, rmdir
, setenv
, setwd
, tmpdirname
, with_env
, with_tmpdir
, with_wd
)
where
import Control.Applicative ((<$>))
import Control.Monad (forM_)
import Control.Monad.Catch (bracket)
import Data.Maybe (fromMaybe)
import Data.Version (versionBranch)
import Foreign.Lua (Lua, NumResults (..), Optional (..))
import Foreign.Lua.Module.SystemUtils
import qualified Data.Map as Map
import qualified Foreign.Lua as Lua
import qualified System.Directory as Directory
import qualified System.Environment as Env
import qualified System.Info as Info
import qualified System.IO.Temp as Temp
pushModule :: Lua NumResults
pushModule :: Lua NumResults
pushModule = do
Lua ()
Lua.newtable
String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield String
"arch" String
arch
String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield String
"compiler_name" String
compiler_name
String -> [Int] -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield String
"compiler_version" [Int]
compiler_version
String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield String
"os" String
os
String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"env" Lua NumResults
env
String -> (String -> Lua (Optional String)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"getenv" String -> Lua (Optional String)
getenv
String -> Lua String -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"getwd" Lua String
getwd
String -> (Optional String -> Lua [String]) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"ls" Optional String -> Lua [String]
ls
String -> (String -> Bool -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"mkdir" String -> Bool -> Lua ()
mkdir
String -> (String -> Bool -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"rmdir" String -> Bool -> Lua ()
rmdir
String -> (String -> String -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"setenv" String -> String -> Lua ()
setenv
String -> (String -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"setwd" String -> Lua ()
setwd
String -> Lua String -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"tmpdirname" Lua String
tmpdirname
String
-> (Map String String -> Callback -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"with_env" Map String String -> Callback -> Lua NumResults
with_env
String
-> (String -> AnyValue -> Optional Callback -> Lua NumResults)
-> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"with_tmpdir" String -> AnyValue -> Optional Callback -> Lua NumResults
with_tmpdir
String -> (String -> Callback -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction String
"with_wd" String -> Callback -> Lua NumResults
with_wd
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
preloadModule :: String -> Lua ()
preloadModule :: String -> Lua ()
preloadModule = (String -> Lua NumResults -> Lua ())
-> Lua NumResults -> String -> Lua ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Lua NumResults -> Lua ()
Lua.preloadhs Lua NumResults
pushModule
arch :: String
arch :: String
arch = String
Info.arch
compiler_name :: String
compiler_name :: String
compiler_name = String
Info.compilerName
compiler_version :: [Int]
compiler_version :: [Int]
compiler_version = Version -> [Int]
versionBranch Version
Info.compilerVersion
os :: String
os :: String
os = String
Info.os
env :: Lua NumResults
env :: Lua NumResults
env = do
[(String, String)]
kvs <- IO [(String, String)] -> Lua [(String, String)]
forall a. IO a -> Lua a
ioToLua IO [(String, String)]
Env.getEnvironment
let addValue :: (a, a) -> Lua ()
addValue (a
k, a
v) = a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push a
k Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push a
v Lua () -> Lua () -> Lua ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua ()
Lua.rawset (-StackIndex
3)
Lua ()
Lua.newtable
((String, String) -> Lua ()) -> [(String, String)] -> Lua ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> Lua ()
forall a a. (Pushable a, Pushable a) => (a, a) -> Lua ()
addValue [(String, String)]
kvs
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)
getwd :: Lua FilePath
getwd :: Lua String
getwd = IO String -> Lua String
forall a. IO a -> Lua a
ioToLua IO String
Directory.getCurrentDirectory
getenv :: String -> Lua (Optional String)
getenv :: String -> Lua (Optional String)
getenv String
name = IO (Optional String) -> Lua (Optional String)
forall a. IO a -> Lua a
ioToLua (Maybe String -> Optional String
forall a. Maybe a -> Optional a
Optional (Maybe String -> Optional String)
-> IO (Maybe String) -> IO (Optional String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
Env.lookupEnv String
name)
ls :: Optional FilePath -> Lua [FilePath]
ls :: Optional String -> Lua [String]
ls Optional String
fp = do
let fp' :: String
fp' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." (Optional String -> Maybe String
forall a. Optional a -> Maybe a
fromOptional Optional String
fp)
IO [String] -> Lua [String]
forall a. IO a -> Lua a
ioToLua (String -> IO [String]
Directory.listDirectory String
fp')
mkdir :: FilePath -> Bool -> Lua ()
mkdir :: String -> Bool -> Lua ()
mkdir String
fp Bool
createParent =
if Bool
createParent
then IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (Bool -> String -> IO ()
Directory.createDirectoryIfMissing Bool
True String
fp)
else IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (String -> IO ()
Directory.createDirectory String
fp)
rmdir :: FilePath -> Bool -> Lua ()
rmdir :: String -> Bool -> Lua ()
rmdir String
fp Bool
recursive =
if Bool
recursive
then IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (String -> IO ()
Directory.removeDirectoryRecursive String
fp)
else IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (String -> IO ()
Directory.removeDirectory String
fp)
setenv :: String -> String -> Lua ()
setenv :: String -> String -> Lua ()
setenv String
name String
value = IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (String -> String -> IO ()
Env.setEnv String
name String
value)
setwd :: FilePath -> Lua ()
setwd :: String -> Lua ()
setwd String
fp = IO () -> Lua ()
forall a. IO a -> Lua a
ioToLua (IO () -> Lua ()) -> IO () -> Lua ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
Directory.setCurrentDirectory String
fp
tmpdirname :: Lua FilePath
tmpdirname :: Lua String
tmpdirname = IO String -> Lua String
forall a. IO a -> Lua a
ioToLua IO String
Directory.getTemporaryDirectory
with_wd :: FilePath -> Callback -> Lua NumResults
with_wd :: String -> Callback -> Lua NumResults
with_wd String
fp Callback
callback =
Lua String
-> (String -> Lua ())
-> (String -> Lua NumResults)
-> Lua NumResults
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO String -> Lua String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO IO String
Directory.getCurrentDirectory)
(IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO () -> Lua ()) -> (String -> IO ()) -> String -> Lua ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Directory.setCurrentDirectory)
((String -> Lua NumResults) -> Lua NumResults)
-> (String -> Lua NumResults) -> Lua NumResults
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
IO () -> Lua ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (String -> IO ()
Directory.setCurrentDirectory String
fp)
Callback
callback Callback -> String -> Lua NumResults
`invokeWithFilePath` String
fp
with_env :: Map.Map String String -> Callback -> Lua NumResults
with_env :: Map String String -> Callback -> Lua NumResults
with_env Map String String
environment Callback
callback =
Lua [(String, String)]
-> ([(String, String)] -> Lua ())
-> ([(String, String)] -> Lua NumResults)
-> Lua NumResults
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO [(String, String)] -> Lua [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO IO [(String, String)]
Env.getEnvironment)
[(String, String)] -> Lua ()
forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Foldable t) =>
t (String, String) -> m ()
setEnvironment
(\[(String, String)]
_ -> [(String, String)] -> Lua ()
forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Foldable t) =>
t (String, String) -> m ()
setEnvironment (Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String String
environment) Lua () -> Lua NumResults -> Lua NumResults
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Callback -> Lua NumResults
invoke Callback
callback)
where
setEnvironment :: t (String, String) -> m ()
setEnvironment t (String, String)
newEnv = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Lua.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[(String, String)]
curEnv <- IO [(String, String)]
Env.getEnvironment
[(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
curEnv (String -> IO ()
Env.unsetEnv (String -> IO ())
-> ((String, String) -> String) -> (String, String) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)
t (String, String) -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
newEnv ((String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
Env.setEnv)
with_tmpdir :: String
-> AnyValue
-> Optional Callback
-> Lua NumResults
with_tmpdir :: String -> AnyValue -> Optional Callback -> Lua NumResults
with_tmpdir String
parentDir AnyValue
tmpl Optional Callback
callback =
case Optional Callback -> Maybe Callback
forall a. Optional a -> Maybe a
fromOptional Optional Callback
callback of
Maybe Callback
Nothing -> do
let tmpl' :: String
tmpl' = String
parentDir
Callback
callback' <- StackIndex -> Lua Callback
forall a. Peekable a => StackIndex -> Lua a
Lua.peek (AnyValue -> StackIndex
fromAnyValue AnyValue
tmpl)
String -> (String -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
Temp.withSystemTempDirectory String
tmpl' (Callback -> String -> Lua NumResults
invokeWithFilePath Callback
callback')
Just Callback
callback' -> do
String
tmpl' <- StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
Lua.peek (AnyValue -> StackIndex
fromAnyValue AnyValue
tmpl)
String -> String -> (String -> Lua NumResults) -> Lua NumResults
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
Temp.withTempDirectory String
parentDir String
tmpl' (Callback -> String -> Lua NumResults
invokeWithFilePath Callback
callback')