aboutsummaryrefslogtreecommitdiff
path: root/Command.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command.hs')
-rw-r--r--Command.hs70
1 files changed, 69 insertions, 1 deletions
diff --git a/Command.hs b/Command.hs
index 90c4d5385..21d636463 100644
--- a/Command.hs
+++ b/Command.hs
@@ -1,4 +1,4 @@
-{- git-annex command types
+{- git-annex commands
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
@@ -7,10 +7,17 @@
module Command where
+import Control.Monad.State (liftIO)
+import System.Directory
+import System.Posix.Files
+import Control.Monad (filterM)
+
import Types
import qualified Backend
import Messages
import qualified Annex
+import qualified GitRepo as Git
+import Locations
{- A subcommand runs in four stages.
-
@@ -87,3 +94,64 @@ isAnnexed file a = do
case (r) of
Just v -> a v
Nothing -> return Nothing
+
+{- These functions find appropriate files or other things based on a
+ user's parameters, and run a specified action on them. -}
+withFilesInGit :: SubCmdSeekStrings
+withFilesInGit a params = do
+ repo <- Annex.gitRepo
+ files <- liftIO $ mapM (Git.inRepo repo) params
+ return $ map a $ filter notState $ foldl (++) [] files
+withFilesMissing :: SubCmdSeekStrings
+withFilesMissing a params = do
+ files <- liftIO $ filterM missing params
+ return $ map a $ filter notState files
+ where
+ missing f = do
+ e <- doesFileExist f
+ return $ not e
+withFilesNotInGit :: SubCmdSeekBackendFiles
+withFilesNotInGit a params = do
+ repo <- Annex.gitRepo
+ newfiles <- liftIO $ mapM (Git.notInRepo repo) params
+ backendPairs a $ filter notState $ foldl (++) [] newfiles
+withFilesUnlocked :: SubCmdSeekBackendFiles
+withFilesUnlocked a params = do
+ -- unlocked files have changed type from a symlink to a regular file
+ repo <- Annex.gitRepo
+ typechangedfiles <- liftIO $ mapM (Git.typeChangedFiles repo) params
+ unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
+ backendPairs a $ filter notState unlockedfiles
+backendPairs :: SubCmdSeekBackendFiles
+backendPairs a files = do
+ pairs <- Backend.chooseBackends files
+ return $ map a pairs
+withDescription :: SubCmdSeekStrings
+withDescription a params = return [a $ unwords params]
+withFilesToBeCommitted :: SubCmdSeekStrings
+withFilesToBeCommitted a params = do
+ repo <- Annex.gitRepo
+ tocommit <- liftIO $ mapM (Git.stagedFiles repo) params
+ return $ map a $ filter notState $ foldl (++) [] tocommit
+withUnlockedFilesToBeCommitted :: SubCmdSeekStrings
+withUnlockedFilesToBeCommitted a params = do
+ repo <- Annex.gitRepo
+ typechangedfiles <- liftIO $ mapM (Git.typeChangedStagedFiles repo) params
+ unlockedfiles <- liftIO $ filterM notSymlink $ foldl (++) [] typechangedfiles
+ return $ map a $ filter notState unlockedfiles
+withKeys :: SubCmdSeekStrings
+withKeys a params = return $ map a params
+withTempFile :: SubCmdSeekStrings
+withTempFile a params = return $ map a params
+withNothing :: SubCmdSeekNothing
+withNothing a _ = return [a]
+
+{- filter out files from the state directory -}
+notState :: FilePath -> Bool
+notState f = stateLoc /= take (length stateLoc) f
+
+{- filter out symlinks -}
+notSymlink :: FilePath -> IO Bool
+notSymlink f = do
+ s <- liftIO $ getSymbolicLinkStatus f
+ return $ not $ isSymbolicLink s