fix windows build (and make --stop work on windows, incidentially)

The Utility.PID will clean up other code soon.

2 files changed, 41 insertions, 5 deletions

diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index 1654821af..970f26c3e 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -1,6 +1,6 @@
 {- daemon support
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@
 module Utility.Daemon where
 
 import Common
+import Utility.PID
 #ifndef mingw32_HOST_OS
 import Utility.LogFile
 #endif
@@ -19,6 +20,7 @@ import System.Posix
 import Control.Concurrent.Async
 #else
 import System.PosixCompat.Types
+import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT
 #endif
 
 #ifndef mingw32_HOST_OS
@@ -70,7 +72,7 @@ lockPidFile file = do
 		(Nothing, _) -> alreadyRunning
 		(_, Nothing) -> alreadyRunning
 		_ -> do
-			_ <- fdWrite fd' =<< show <$> getProcessID
+			_ <- fdWrite fd' =<< show <$> getPID
 			closeFd fd
 #else
 	writeFile newfile "-1"
@@ -86,7 +88,7 @@ alreadyRunning = error "Daemon is already running."
  - is locked by the same process that is listed in the pid file.
  -
  - If it's running, returns its pid. -}
-checkDaemon :: FilePath -> IO (Maybe ProcessID)
+checkDaemon :: FilePath -> IO (Maybe PID)
 #ifndef mingw32_HOST_OS
 checkDaemon pidfile = do
 	v <- catchMaybeIO $
@@ -110,11 +112,14 @@ checkDaemon pidfile = do
 checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile)
 #endif
 
-#ifndef mingw32_HOST_OS
 {- Stops the daemon, safely. -}
 stopDaemon :: FilePath -> IO ()
 stopDaemon pidfile = go =<< checkDaemon pidfile
   where
 	go Nothing = noop
-	go (Just pid) = signalProcess sigTERM pid
+	go (Just pid) =
+#ifndef mingw32_HOST_OS
+		signalProcess sigTERM pid
+#else
+		generateConsoleCtrlEvent cTRL_C_EVENT pid
 #endif
diff --git a/Utility/PID.hs b/Utility/PID.hs
new file mode 100644
index 000000000..4867bd6de
--- /dev/null
+++ b/Utility/PID.hs
@@ -0,0 +1,31 @@
+{- process ids
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.PID where
+
+#ifndef mingw32_HOST_OS
+import System.Posix.Types (ProcessID)
+import System.Posix.Process (getProcessID)
+#else
+import System.Win32.Process (ProcessId)
+import System.Win32.Process.Current (getCurrentProcessId)
+#endif
+
+#ifndef mingw32_HOST_OS
+type PID = ProcessID
+#else
+type PID = ProcessId
+#endif
+
+getPID :: IO PID
+#ifndef mingw32_HOST_OS
+getPID = getProcessID
+#else
+getPID = getCurrentProcessId
+#endif