(no subject)

[geniepro]

Иногда нужно, что бы программа была запущена лишь в одном экземпляре.
Обычно (Win32) в таких случаях при запуске программы пытаются создать мьютекс, и если он уже существует, значит уже выполняется другая копия этой программы. Если же мьютекс удаётся создать, значит программа запущена в единственном экземпляре.
После выполнения нужной работы мьютекс уничтожается.

На сях это выглядит примерно так:

#include
#include
#include

const char *MutexName = "TestMutex";

int main(int argc, char *argv[])
{
HANDLE hMutex = CreateMutexA(0, 0, MutexName);
if (GetLastError() != ERROR_ALREADY_EXISTS &&
GetLastError() != ERROR_ACCESS_DENIED)
{
printf("Hello, world\n");
getch();

ReleaseMutex(hMutex);
}
return 0;
}
На хаскелле же это может выглядеть так:


module Main where

import Control.Monad
import qualified Graphics.Win32 as W32
import Foreign.C.String

--------------------------------------------------------------------------------

mutexName = "TestMutex"

main = withMutex mutexName $ do
putStrLn "Hello, world"
getChar
return ()

--------------------------------------------------------------------------------
-- Создаёт мьютекс с именем mutexName
-- Если мьютекс создан успешно, выполняет действие action
-- После завершения действия action мьютекс уничтожается
--
withMutex :: String -> IO () -> IO ()
withMutex mutexName action = do
withCString mutexName $ \c_mutexName -> do
mHandle <- c_CreateMutex 0 0 c_mutexName
lastErr <- c_GetLastError
let exists = lastErr == eRROR_ALREADY_EXISTS ||
lastErr == eRROR_ACCESS_DENIED
when (not exists) $ do
action
c_ReleaseMutex mHandle
return ()

--------------------------------------------------------------------------------
-- Cannot create a file when that file already exists
--
eRROR_ALREADY_EXISTS :: W32.DWORD
eRROR_ALREADY_EXISTS = 183

eRROR_ACCESS_DENIED :: W32.DWORD
eRROR_ACCESS_DENIED = 5

--------------------------------------------------------------------------------

foreign import stdcall unsafe "CreateMutexA"
c_CreateMutex :: W32.INT -> W32.INT -> CString -> IO W32.HANDLE

foreign import stdcall unsafe "ReleaseMutex"
c_ReleaseMutex :: W32.HANDLE -> IO W32.BOOL

foreign import stdcall unsafe "GetLastError"
c_GetLastError :: IO W32.DWORD

ЗЫ. Может, кто знает, как делать такие вещи более правильно, в хаскель-вее?

ЗЗЫ. Кстати, ссылка по теме: http://www.rsdn.ru/article/baseserv/avins.xml