diff options
| author |  Joey Hess <joey@kitenet.net> | 2013-03-11 13:52:06 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2013-03-11 13:55:36 -0400 |
| commit | 893860527ee8044cf990abaf03bf0405ff1ddd53 (patch) | |
| tree | 7fca45b576b5913d2e8556950ccef844dd32a92e | |
| parent | 71cd744329491c7480bbf168c5f4630037d30688 (diff) | |
fix changeFile to not be partial
That led to runtime crashes, without even a warning from -Wall. Yipes!
| -rw-r--r-- | Assistant/Threads/Committer.hs | 5 | ||||
| -rw-r--r-- | Assistant/Types/Changes.hs | 15 |
2 files changed, 13 insertions, 7 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 5be190c4a..e77c55dfd 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -390,7 +390,7 @@ safeToAdd delayadd pending inprocess = do - transfer scan does the same thing then. -} checkChangeContent :: Change -> Assistant () -checkChangeContent (Change { changeInfo = i , changeFile = f }) = +checkChangeContent change@(Change { changeInfo = i }) = case changeInfoKey i of Nothing -> noop 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 else queueTransfers "new or renamed file wanted" Next k (Just f) Download handleDrops "file renamed" present k (Just f) Nothing + where + f = changeFile change checkChangeContent _ = noop - diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs index ee797b8fe..9f0aad7a7 100644 --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -24,15 +24,18 @@ changeInfoKey _ = Nothing type ChangeChan = TSet Change +newChangeChan :: IO ChangeChan +newChangeChan = atomically newTSet + data Change = Change { changeTime :: UTCTime - , changeFile :: FilePath + , _changeFile :: FilePath , changeInfo :: ChangeInfo } | PendingAddChange { changeTime ::UTCTime - , changeFile :: FilePath + , _changeFile :: FilePath } | InProcessAddChange { changeTime ::UTCTime @@ -40,8 +43,10 @@ data Change } deriving (Show) -newChangeChan :: IO ChangeChan -newChangeChan = atomically newTSet +changeFile :: Change -> FilePath +changeFile (Change _ f _) = f +changeFile (PendingAddChange _ f) = f +changeFile (InProcessAddChange _ ks) = keyFilename ks isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True @@ -54,7 +59,7 @@ isInProcessAddChange _ = False finishedChange :: Change -> Key -> Change finishedChange c@(InProcessAddChange { keySource = ks }) k = Change { changeTime = changeTime c - , changeFile = keyFilename ks + , _changeFile = keyFilename ks , changeInfo = AddChange k } finishedChange c _ = c |