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 "arch" String
arch
String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield "compiler_name" String
compiler_name
String -> [Int] -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield "compiler_version" [Int]
compiler_version
String -> String -> Lua ()
forall a. Pushable a => String -> a -> Lua ()
Lua.addfield "os" String
os
String -> Lua NumResults -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "env" Lua NumResults
env
String -> (String -> Lua (Optional String)) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "getenv" String -> Lua (Optional String)
getenv
String -> Lua String -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "getwd" Lua String
getwd
String -> (Optional String -> Lua [String]) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "ls" Optional String -> Lua [String]
ls
String -> (String -> Bool -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "mkdir" String -> Bool -> Lua ()
mkdir
String -> (String -> Bool -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "rmdir" String -> Bool -> Lua ()
rmdir
String -> (String -> String -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "setenv" String -> String -> Lua ()
setenv
String -> (String -> Lua ()) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "setwd" String -> Lua ()
setwd
String -> Lua String -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "tmpdirname" Lua String
tmpdirname
String
-> (Map String String -> Callback -> Lua NumResults) -> Lua ()
forall a. ToHaskellFunction a => String -> a -> Lua ()
Lua.addfunction "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 "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 "with_wd" String -> Callback -> Lua NumResults
with_wd
NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return 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 (k :: a
k, v :: 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 (-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 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 name :: 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 fp :: Optional String
fp = do
let fp' :: String
fp' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "." (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 fp :: String
fp createParent :: 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 fp :: String
fp recursive :: 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 name :: String
name value :: 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 fp :: 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 fp :: String
fp callback :: 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
$ \_ -> 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 environment :: Map String String
environment callback :: 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)] -> 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 newEnv :: 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 parentDir :: String
parentDir tmpl :: AnyValue
tmpl callback :: Optional Callback
callback =
case Optional Callback -> Maybe Callback
forall a. Optional a -> Maybe a
fromOptional Optional Callback
callback of
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
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')