fdToHandle seems to close the fd

avoid excess trailing newline
This commit is contained in:
Joey Hess 2012-07-01 16:10:00 -04:00
parent e5fd8b67b7
commit 8c10f37714

View file

@ -21,20 +21,25 @@ import Data.Time.Clock
{- Enough information to uniquely identify a transfer, used as the filename {- Enough information to uniquely identify a transfer, used as the filename
- of the transfer information file. -} - of the transfer information file. -}
data Transfer = Transfer Direction Remote Key data Transfer = Transfer
deriving (Show) { transferDirection :: Direction
, transferRemote :: Remote
, transferKey :: Key
}
deriving (Show, Eq, Ord)
{- Information about a Transfer, stored in the transfer information file. -} {- Information about a Transfer, stored in the transfer information file. -}
data TransferInfo = TransferInfo data TransferInfo = TransferInfo
{ transferPid :: Maybe ProcessID { startedTime :: UTCTime
, transferPid :: Maybe ProcessID
, transferThread :: Maybe ThreadId , transferThread :: Maybe ThreadId
, startedTime :: UTCTime
, bytesComplete :: Maybe Integer , bytesComplete :: Maybe Integer
, associatedFile :: Maybe FilePath , associatedFile :: Maybe FilePath
} }
deriving (Show) deriving (Show, Eq, Ord)
data Direction = Upload | Download data Direction = Upload | Download
deriving (Eq, Ord)
instance Show Direction where instance Show Direction where
show Upload = "upload" show Upload = "upload"
@ -61,9 +66,9 @@ transfer t file a = do
createAnnexDirectory $ takeDirectory tfile createAnnexDirectory $ takeDirectory tfile
mode <- annexFileMode mode <- annexFileMode
info <- liftIO $ TransferInfo info <- liftIO $ TransferInfo
<$> pure Nothing -- pid not stored in file, so omitted for speed <$> getCurrentTime
<*> pure Nothing -- pid not stored in file, so omitted for speed
<*> pure Nothing -- threadid not stored in file, so omitted for speed <*> pure Nothing -- threadid not stored in file, so omitted for speed
<*> getCurrentTime
<*> pure Nothing -- not 0; transfer may be resuming <*> pure Nothing -- not 0; transfer may be resuming
<*> pure file <*> pure file
bracketIO (prep tfile mode info) (cleanup tfile) a bracketIO (prep tfile mode info) (cleanup tfile) a
@ -103,7 +108,7 @@ checkTransfer t = do
h <- fdToHandle fd h <- fdToHandle fd
info <- readTransferInfo pid info <- readTransferInfo pid
<$> hGetContentsStrict h <$> hGetContentsStrict h
closeFd fd hClose h
return info return info
{- Gets all currently running transfers. -} {- Gets all currently running transfers. -}
@ -152,9 +157,9 @@ readTransferInfo :: ProcessID -> String -> Maybe TransferInfo
readTransferInfo pid s = readTransferInfo pid s =
case bits of case bits of
[time] -> TransferInfo [time] -> TransferInfo
<$> pure (Just pid) <$> readish time
<*> pure (Just pid)
<*> pure Nothing <*> pure Nothing
<*> readish time
<*> pure Nothing <*> pure Nothing
<*> pure filename <*> pure filename
_ -> Nothing _ -> Nothing
@ -162,4 +167,4 @@ readTransferInfo pid s =
(bits, filebits) = splitAt 1 $ lines s (bits, filebits) = splitAt 1 $ lines s
filename filename
| null filebits = Nothing | null filebits = Nothing
| otherwise = Just $ unlines filebits | otherwise = Just $ join "\n" filebits