import Control.Concurrent
import System.Directory (doesFileExist, getAppUserDataDirectory,
    removeFile)
import System.IO (withFile, Handle, IOMode(WriteMode), hPutStr)

oneInstance :: IO ()
oneInstance = do
    
    user <- getAppUserDataDirectory "myapp.lock"
    locked <- doesFileExist user
    if locked
    then print "There is already one instance of this program running."
    else do
        t <- myThreadId
        
        
        
        withFile user WriteMode (do_program t)
        
        removeFile user

do_program :: ThreadId -> Handle -> IO ()
do_program t h = do
    let s = "Locked by thread: " ++ show t
    
    putStrLn s
    
    
    hPutStr h s
    
    threadDelay 1000000

main :: IO ()
main = do
    
    forkIO oneInstance
    
    threadDelay 500000
    
    
    forkIO oneInstance
    return ()