summaryrefslogtreecommitdiff
path: root/Logs/Transfer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Logs/Transfer.hs')
-rw-r--r--Logs/Transfer.hs35
1 files changed, 28 insertions, 7 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index b96b827c6..a278fce35 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -18,11 +18,6 @@ import Utility.Metered
import Utility.Percentage
import Utility.QuickCheck
-#ifndef mingw32_HOST_OS
-import System.Posix.Types (ProcessID)
-#else
-import System.Win32.Process (ProcessId)
-#endif
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time
@@ -30,6 +25,13 @@ import System.Locale
import Control.Concurrent
#ifndef mingw32_HOST_OS
+import System.Posix.Types (ProcessID)
+#else
+import System.Win32.Process (ProcessId)
+import System.Win32.Process.Current (getCurrentProcessId)
+#endif
+
+#ifndef mingw32_HOST_OS
type PID = ProcessID
#else
type PID = ProcessId
@@ -214,7 +216,11 @@ mkProgressUpdater t info = do
startTransferInfo :: Maybe FilePath -> IO TransferInfo
startTransferInfo file = TransferInfo
<$> (Just . utcTimeToPOSIXSeconds <$> getCurrentTime)
+#ifndef mingw32_HOST_OS
<*> pure Nothing -- pid not stored in file, so omitted for speed
+#else
+ <*> (Just <$> getCurrentProcessId)
+#endif
<*> pure Nothing -- tid ditto
<*> pure Nothing -- not 0; transfer may be resuming
<*> pure Nothing
@@ -328,13 +334,18 @@ writeTransferInfoFile info tfile = do
{- File format is a header line containing the startedTime and any
- bytesComplete value. Followed by a newline and the associatedFile.
-
- - The transferPid is not included; instead it is obtained by looking
- - at the process that locks the file.
+ - On unix, the transferPid is not included; instead it is obtained
+ - by looking at the process that locks the file.
+ -
+ - On windows, the transferPid is included, as a second line.
-}
writeTransferInfo :: TransferInfo -> String
writeTransferInfo info = unlines
[ (maybe "" show $ startedTime info) ++
(maybe "" (\b -> ' ' : show b) (bytesComplete info))
+#ifdef mingw32_HOST_OS
+ , maybe "" show (transferPid info)
+#endif
, fromMaybe "" $ associatedFile info -- comes last; arbitrary content
]
@@ -347,14 +358,24 @@ readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do
readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo
readTransferInfo mpid s = TransferInfo
<$> time
+#ifdef mingw32_HOST_OS
+ <*> pure $ if isJust mpid then mpid else mpid'
+#else
<*> pure mpid
+#endif
<*> pure Nothing
<*> pure Nothing
<*> bytes
<*> pure (if null filename then Nothing else Just filename)
<*> pure False
where
+#ifdef mingw32_HOST_OS
+ (firstline, rem) = separate (== '\n') s
+ (secondline, rest) = separate (== '\n') rem
+ mpid' = readish secondline
+#else
(firstline, rest) = separate (== '\n') s
+#endif
filename
| end rest == "\n" = beginning rest
| otherwise = rest