summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs55
-rw-r--r--Command/Commit.hs2
-rw-r--r--Command/DropUnused.hs2
-rw-r--r--Command/Fix.hs2
-rw-r--r--Command/FromKey.hs2
-rw-r--r--Command/Fsck.hs8
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/Lock.hs2
-rw-r--r--Command/Move.hs4
-rw-r--r--Command/Uninit.hs4
-rw-r--r--Command/Unused.hs4
-rw-r--r--Command/Watch.hs38
-rw-r--r--Command/Whereis.hs2
13 files changed, 88 insertions, 39 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 2c671eea2..ccdff67ec 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -50,34 +50,40 @@ start file = notBareRepo $ ifAnnexed file fixup add
- to prevent it from being modified in between. It's hard linked into a
- temporary location, and its writable bits are removed. It could still be
- written to by a process that already has it open for writing. -}
-perform :: FilePath -> CommandPerform
-perform file = do
+lockDown :: FilePath -> Annex FilePath
+lockDown file = do
liftIO $ preventWrite file
tmp <- fromRepo gitAnnexTmpDir
createAnnexDirectory tmp
pid <- liftIO getProcessID
let tmpfile = tmp </> "add" ++ show pid ++ "." ++ takeFileName file
- nuke tmpfile
+ liftIO $ nukeFile tmpfile
liftIO $ createLink file tmpfile
+ return tmpfile
+
+{- Moves the file into the annex. -}
+ingest :: FilePath -> Annex (Maybe Key)
+ingest file = do
+ tmpfile <- lockDown file
let source = KeySource { keyFilename = file, contentLocation = tmpfile }
backend <- chooseBackend file
genKey source backend >>= go tmpfile
where
- go _ Nothing = stop
+ go _ Nothing = return Nothing
go tmpfile (Just (key, _)) = do
handle (undo file key) $ moveAnnex key tmpfile
- nuke file
- next $ cleanup file key True
+ liftIO $ nukeFile file
+ return $ Just key
-nuke :: FilePath -> Annex ()
-nuke file = liftIO $ whenM (doesFileExist file) $ removeFile file
+perform :: FilePath -> CommandPerform
+perform file = maybe stop (\key -> next $ cleanup file key True) =<< ingest file
{- On error, put the file back so it doesn't seem to have vanished.
- This can be called before or after the symlink is in place. -}
undo :: FilePath -> Key -> IOException -> Annex a
undo file key e = do
whenM (inAnnex key) $ do
- nuke file
+ liftIO $ nukeFile file
handle tryharder $ fromAnnex key file
logStatus key InfoMissing
throw e
@@ -88,24 +94,29 @@ undo file key e = do
src <- inRepo $ gitAnnexLocation key
liftIO $ moveFile src file
-cleanup :: FilePath -> Key -> Bool -> CommandCleanup
-cleanup file key hascontent = do
- handle (undo file key) $ do
- link <- calcGitLink file key
- liftIO $ createSymbolicLink link file
+{- Creates the symlink to the annexed content. -}
+link :: FilePath -> Key -> Bool -> Annex ()
+link file key hascontent = handle (undo file key) $ do
+ l <- calcGitLink file key
+ liftIO $ createSymbolicLink l file
- when hascontent $ do
- logStatus key InfoPresent
+ when hascontent $ do
+ logStatus key InfoPresent
- -- touch the symlink to have the same mtime as the
- -- file it points to
- liftIO $ do
- mtime <- modificationTime <$> getFileStatus file
- touch file (TimeSpec mtime) False
+ -- touch the symlink to have the same mtime as the
+ -- file it points to
+ liftIO $ do
+ mtime <- modificationTime <$> getFileStatus file
+ touch file (TimeSpec mtime) False
+{- Note: Several other commands call this, and expect it to
+ - create the symlink and add it. -}
+cleanup :: FilePath -> Key -> Bool -> CommandCleanup
+cleanup file key hascontent = do
+ _ <- link file key hascontent
params <- ifM (Annex.getState Annex.force)
( return [Param "-f"]
, return []
)
- Annex.Queue.add "add" (params++[Param "--"]) [file]
+ Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
return True
diff --git a/Command/Commit.hs b/Command/Commit.hs
index 1c82ed7df..d3ce3d7bb 100644
--- a/Command/Commit.hs
+++ b/Command/Commit.hs
@@ -22,7 +22,7 @@ seek = [withNothing start]
start :: CommandStart
start = next $ next $ do
Annex.Branch.commit "update"
- _ <- runhook =<< (inRepo $ Git.hookPath "annex-content")
+ _ <- runhook <=< inRepo $ Git.hookPath "annex-content"
return True
where
runhook (Just hook) = liftIO $ boolSystem hook []
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index a94c2873d..597a4eec0 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -40,5 +40,5 @@ perform key = maybe droplocal dropremote =<< Remote.byName =<< from
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do
f <- fromRepo $ filespec key
- liftIO $ whenM (doesFileExist f) $ removeFile f
+ liftIO $ nukeFile f
next $ return True
diff --git a/Command/Fix.hs b/Command/Fix.hs
index c4f981381..227e08cd2 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -36,5 +36,5 @@ perform file link = do
cleanup :: FilePath -> CommandCleanup
cleanup file = do
- Annex.Queue.add "add" [Param "--force", Param "--"] [file]
+ Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
return True
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index ec194e06e..f7841c977 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -39,5 +39,5 @@ perform key file = do
cleanup :: FilePath -> CommandCleanup
cleanup file = do
- Annex.Queue.add "add" [Param "--"] [file]
+ Annex.Queue.addCommand "add" [Param "--"] [file]
return True
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index ae21acf8a..7bfc46f4a 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -145,17 +145,17 @@ fixLink key file = do
-}
whenM (liftIO $ doesFileExist file) $
unlessM (inAnnex key) $ do
- showNote $ "fixing content location"
+ showNote "fixing content location"
dir <- liftIO $ parentDir <$> absPath file
let content = absPathFrom dir have
liftIO $ allowWrite (parentDir content)
moveAnnex key content
- showNote $ "fixing link"
+ showNote "fixing link"
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ removeFile file
liftIO $ createSymbolicLink want file
- Annex.Queue.add "add" [Param "--force", Param "--"] [file]
+ Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file]
return True
{- Checks that the location log reflects the current status of the key,
@@ -220,7 +220,7 @@ checkKeySize' key file bad = case Types.Key.keySize key of
Nothing -> return True
Just size -> do
size' <- fromIntegral . fileSize
- <$> (liftIO $ getFileStatus file)
+ <$> liftIO (getFileStatus file)
comparesizes size size'
where
comparesizes a b = do
diff --git a/Command/Get.hs b/Command/Get.hs
index 772fbd90c..c4ba48312 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -26,7 +26,7 @@ start from file (key, _) = stopUnless (not <$> inAnnex key) $
autoCopies file key (<) $ \_numcopies ->
case from of
Nothing -> go $ perform key
- Just src -> do
+ Just src ->
-- get --from = copy --from
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key
diff --git a/Command/Lock.hs b/Command/Lock.hs
index ab97b14bc..8aadf3f59 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -24,5 +24,5 @@ start file = do
perform :: FilePath -> CommandPerform
perform file = do
- Annex.Queue.add "checkout" [Param "--"] [file]
+ Annex.Queue.addCommand "checkout" [Param "--"] [file]
next $ return True -- no cleanup needed
diff --git a/Command/Move.hs b/Command/Move.hs
index 8612c9f2d..6ec7cd90a 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -128,9 +128,9 @@ fromOk src key
expensive = do
u <- getUUID
remotes <- Remote.keyPossibilities key
- return $ u /= Remote.uuid src && any (== src) remotes
+ return $ u /= Remote.uuid src && elem src remotes
fromPerform :: Remote -> Bool -> Key -> CommandPerform
-fromPerform src move key = moveLock move key $ do
+fromPerform src move key = moveLock move key $
ifM (inAnnex key)
( handle move True
, do
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index 5724bffd0..46a2480e6 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -28,8 +28,8 @@ check = do
"cannot uninit when the " ++ show b ++ " branch is checked out"
top <- fromRepo Git.repoPath
cwd <- liftIO getCurrentDirectory
- whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $ error $
- "can only run uninit from the top of the git repository"
+ whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $
+ error "can only run uninit from the top of the git repository"
where
current_branch = Git.Ref . Prelude.head . lines <$> revhead
revhead = inRepo $ Git.Command.pipeRead
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 1224d0545..03a709534 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -84,7 +84,7 @@ checkRemoteUnused name = go =<< fromJust <$> Remote.byName (Just name)
_ <- check "" (remoteUnusedMsg r) (remoteunused r) 0
next $ return True
remoteunused r =
- excludeReferenced =<< loggedKeysFor (Remote.uuid r)
+ excludeReferenced <=< loggedKeysFor $ Remote.uuid r
check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int
check file msg a c = do
@@ -260,7 +260,7 @@ withKeysReferencedInGit a = do
withKeysReferencedInGitRef :: (Key -> Annex ()) -> Git.Ref -> Annex ()
withKeysReferencedInGitRef a ref = do
showAction $ "checking " ++ Git.Ref.describe ref
- go =<< inRepo (LsTree.lsTree ref)
+ go <=< inRepo $ LsTree.lsTree ref
where
go [] = noop
go (l:ls)
diff --git a/Command/Watch.hs b/Command/Watch.hs
new file mode 100644
index 000000000..5681b3861
--- /dev/null
+++ b/Command/Watch.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+
+{- git-annex watch command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Watch where
+
+import Common.Annex
+import Assistant
+import Command
+import Option
+
+def :: [Command]
+def = [withOptions [foregroundOption, stopOption] $
+ command "watch" paramNothing seek "watch for changes"]
+
+seek :: [CommandSeek]
+seek = [withFlag stopOption $ \stopdaemon ->
+ withFlag foregroundOption $ \foreground ->
+ withNothing $ start foreground stopdaemon]
+
+foregroundOption :: Option
+foregroundOption = Option.flag [] "foreground" "do not daemonize"
+
+stopOption :: Option
+stopOption = Option.flag [] "stop" "stop daemon"
+
+start :: Bool -> Bool -> CommandStart
+start foreground stopdaemon = notBareRepo $ do
+ if stopdaemon
+ then stopDaemon
+ else startDaemon foreground -- does not return
+ stop
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index eb6ea7c56..b697bf554 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -37,7 +37,7 @@ perform remotemap key = do
unless (null safelocations) $ showLongNote pp
pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
- forM_ (catMaybes $ map (`M.lookup` remotemap) locations) $
+ forM_ (mapMaybe (`M.lookup` remotemap) locations) $
performRemote key
if null safelocations then stop else next $ return True
where
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-19 19:06:13 +0000