mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

AssociatedFile newtype

Browse source 
To prevent any further mistakes like 301aff34c4

This commit was sponsored by Francois Marier on Patreon.
This commit is contained in:
Joey Hess 2017-03-10 13:12:24 -04:00
parent 2cd7496210
commit c8e1e3dada
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
43 changed files with 179 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

12
Annex/Drop.hs
View file

@ -55,8 +55,8 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
)
let fs = case afile of
Just f -> nub (f : l)
Nothing -> l
AssociatedFile (Just f) -> nub (f : l)
AssociatedFile Nothing -> l
n <- getcopies fs
void $ if fromhere && checkcopies n Nothing
then go fs rs n >>= dropl fs
@ -93,9 +93,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
checkdrop fs n u a
| null fs = check $ -- no associated files; unused content
wantDrop True u (Just key) Nothing
wantDrop True u (Just key) (AssociatedFile Nothing)
| otherwise = check $
allM (wantDrop True u (Just key) . Just) fs
allM (wantDrop True u (Just key) . AssociatedFile . Just) fs
where
check c = ifM c
( dodrop n u a
@ -107,7 +107,9 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
( do
liftIO $ debugM "drop" $ unwords
[ "dropped"
, fromMaybe (key2file key) afile
, case afile of
AssociatedFile Nothing -> key2file key
AssociatedFile (Just af) -> af
, "(from " ++ maybe "here" show u ++ ")"
, "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
, ": " ++ reason