pull in Win32-extras, to be able to get current process id in Windows
Fixed up a number of things that had worked around there not being a way to get that. Most notably, transfer info files on windows now include the process id, since no locking is currently done. This means the file format varies between windows and unix.
This commit is contained in:
parent
c01af6285f
commit
011b8bc7ec
6 changed files with 46 additions and 19 deletions
|
@ -18,17 +18,19 @@ 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
|
||||
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
|
||||
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue