diff options
Diffstat (limited to 'Command/AddUrl.hs')
-rw-r--r-- | Command/AddUrl.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 3a6ee7560..80f3582ed 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -19,6 +19,7 @@ import qualified Types.Remote as Remote import qualified Command.Add import Annex.Content import Annex.Ingest +import Annex.CheckIgnore import Annex.UUID import Logs.Web import Types.KeySource @@ -157,7 +158,7 @@ performRemote r relaxed uri file sz = ifAnnexed file adduri geturi geturi = next $ isJust <$> downloadRemoteFile r relaxed uri file sz downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) -downloadRemoteFile r relaxed uri file sz = do +downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do let urlkey = Backend.URL.fromUrl uri sz liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast <||> pure relaxed) @@ -236,7 +237,7 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key) -addUrlFileQuvi relaxed quviurl videourl file = stopUnless (doesNotExist file) $ do +addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do let key = Backend.URL.fromUrl quviurl Nothing ifM (pure relaxed <||> Annex.getState Annex.fast) ( do @@ -285,21 +286,13 @@ addUrlChecked relaxed url u checkexistssize key ) addUrlFile :: Bool -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) -addUrlFile relaxed url urlinfo file = stopUnless (doesNotExist file) $ do +addUrlFile relaxed url urlinfo file = checkCanAdd file $ do liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast <||> pure relaxed) ( nodownload url urlinfo file , downloadWeb url urlinfo file ) -doesNotExist :: FilePath -> Annex Bool -doesNotExist file = go =<< liftIO (catchMaybeIO $ getSymbolicLinkStatus file) - where - go Nothing = return True - go (Just _) = do - warning $ file ++ " already exists and is not annexed; not overwriting" - return False - downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) downloadWeb url urlinfo file = do let dummykey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing @@ -400,3 +393,16 @@ adjustFile o = addprefix . addsuffix where addprefix f = maybe f (++ f) (prefixOption o) addsuffix f = maybe f (f ++) (suffixOption o) + +checkCanAdd :: FilePath -> Annex (Maybe a) -> Annex (Maybe a) +checkCanAdd file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file)) + ( do + warning $ file ++ " already exists and is not annexed; not overwriting" + return Nothing + , ifM ((not <$> Annex.getState Annex.force) <&&> checkIgnored file) + ( do + warning $ "not adding " ++ file ++ " which is .gitignored (use --force to override)" + return Nothing + , a + ) + ) |