fix changeFile to not be partial

That led to runtime crashes, without even a warning from -Wall. Yipes!
This commit is contained in:
Joey Hess 2013-03-11 13:52:06 -04:00
parent 0cad2bf2f0
commit 87cba71d5a
2 changed files with 13 additions and 7 deletions

View file

@ -390,7 +390,7 @@ safeToAdd delayadd pending inprocess = do
- transfer scan does the same thing then. - transfer scan does the same thing then.
-} -}
checkChangeContent :: Change -> Assistant () checkChangeContent :: Change -> Assistant ()
checkChangeContent (Change { changeInfo = i , changeFile = f }) = checkChangeContent change@(Change { changeInfo = i }) =
case changeInfoKey i of case changeInfoKey i of
Nothing -> noop Nothing -> noop
Just k -> whenM (scanComplete <$> getDaemonStatus) $ do Just k -> whenM (scanComplete <$> getDaemonStatus) $ do
@ -399,5 +399,6 @@ checkChangeContent (Change { changeInfo = i , changeFile = f }) =
then queueTransfers "new file created" Next k (Just f) Upload then queueTransfers "new file created" Next k (Just f) Upload
else queueTransfers "new or renamed file wanted" Next k (Just f) Download else queueTransfers "new or renamed file wanted" Next k (Just f) Download
handleDrops "file renamed" present k (Just f) Nothing handleDrops "file renamed" present k (Just f) Nothing
where
f = changeFile change
checkChangeContent _ = noop checkChangeContent _ = noop

View file

@ -24,15 +24,18 @@ changeInfoKey _ = Nothing
type ChangeChan = TSet Change type ChangeChan = TSet Change
newChangeChan :: IO ChangeChan
newChangeChan = atomically newTSet
data Change data Change
= Change = Change
{ changeTime :: UTCTime { changeTime :: UTCTime
, changeFile :: FilePath , _changeFile :: FilePath
, changeInfo :: ChangeInfo , changeInfo :: ChangeInfo
} }
| PendingAddChange | PendingAddChange
{ changeTime ::UTCTime { changeTime ::UTCTime
, changeFile :: FilePath , _changeFile :: FilePath
} }
| InProcessAddChange | InProcessAddChange
{ changeTime ::UTCTime { changeTime ::UTCTime
@ -40,8 +43,10 @@ data Change
} }
deriving (Show) deriving (Show)
newChangeChan :: IO ChangeChan changeFile :: Change -> FilePath
newChangeChan = atomically newTSet changeFile (Change _ f _) = f
changeFile (PendingAddChange _ f) = f
changeFile (InProcessAddChange _ ks) = keyFilename ks
isPendingAddChange :: Change -> Bool isPendingAddChange :: Change -> Bool
isPendingAddChange (PendingAddChange {}) = True isPendingAddChange (PendingAddChange {}) = True
@ -54,7 +59,7 @@ isInProcessAddChange _ = False
finishedChange :: Change -> Key -> Change finishedChange :: Change -> Key -> Change
finishedChange c@(InProcessAddChange { keySource = ks }) k = Change finishedChange c@(InProcessAddChange { keySource = ks }) k = Change
{ changeTime = changeTime c { changeTime = changeTime c
, changeFile = keyFilename ks , _changeFile = keyFilename ks
, changeInfo = AddChange k , changeInfo = AddChange k
} }
finishedChange c _ = c finishedChange c _ = c