Merge branch 'wip'

This commit is contained in:
Joey Hess 2012-01-06 17:51:01 -04:00
commit 6055a95c6f
25 changed files with 226 additions and 75 deletions

View file

@ -6,6 +6,7 @@
-}
module Annex.Branch (
fullname,
name,
hasOrigin,
hasSibling,

View file

@ -30,7 +30,6 @@ import Types.Command as ReExported
import Types.Option as ReExported
import Seek as ReExported
import Checks as ReExported
import Options as ReExported
import Usage as ReExported
import Logs.Trust
import Logs.Location

View file

@ -10,17 +10,19 @@ module Command.Copy where
import Common.Annex
import Command
import qualified Command.Move
import qualified Remote
def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
"copy content of files to/from another repository"]
seek :: [CommandSeek]
seek = [withField "to" id $ \to -> withField "from" id $ \from ->
withNumCopies $ \n -> whenAnnexed $ start to from n]
seek = [withField Command.Move.toOption Remote.byName $ \to ->
withField Command.Move.fromOption Remote.byName $ \from ->
withNumCopies $ \n -> whenAnnexed $ start to from n]
-- A copy is just a move that does not delete the source file.
-- However, --auto mode avoids unnecessary copies.
start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start :: Maybe Remote -> Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
Command.Move.start to from False file (key, backend)

View file

@ -16,24 +16,24 @@ import Logs.Location
import Logs.Trust
import Annex.Content
import Config
import qualified Option
def :: [Command]
def = [withOptions [fromOption] $ command "drop" paramPaths seek
"indicate content of files not currently wanted"]
fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
seek :: [CommandSeek]
seek = [withField "from" id $ \from -> withNumCopies $ \n ->
seek = [withField fromOption Remote.byName $ \from -> withNumCopies $ \n ->
whenAnnexed $ start from n]
start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
case from of
Nothing -> startLocal file numcopies key
Just name -> do
remote <- Remote.byName name
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal file numcopies key

View file

@ -15,6 +15,7 @@ import qualified Annex
import qualified Command.Drop
import qualified Remote
import qualified Git
import qualified Option
import Types.Key
type UnusedMap = M.Map String Key
@ -51,14 +52,14 @@ start (unused, unusedbad, unusedtmp) s = search
next $ a key
perform :: Key -> CommandPerform
perform key = maybe droplocal dropremote =<< Annex.getField "from"
perform key = maybe droplocal dropremote =<< Remote.byName =<< from
where
dropremote name = do
r <- Remote.byName name
dropremote r = do
showAction $ "from " ++ Remote.name r
ok <- Remote.removeKey r key
next $ Command.Drop.cleanupRemote key r ok
droplocal = Command.Drop.performLocal key (Just 0) -- force drop
from = Annex.getField $ Option.name Command.Drop.fromOption
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
performOther filespec key = do

View file

@ -17,23 +17,26 @@ import qualified Annex
import qualified Utility.Format
import Utility.DataUnits
import Types.Key
import qualified Option
def :: [Command]
def = [withOptions [formatOption, print0Option] $
command "find" paramPaths seek "lists available files"]
print0Option :: Option
print0Option = Option [] ["print0"] (NoArg $ Annex.setField "format" "${file}\0")
"terminate output with null"
formatOption :: Option
formatOption = fieldOption [] "format" paramFormat "control format of output"
formatOption = Option.field [] "format" paramFormat "control format of output"
print0Option :: Option
print0Option = Option.Option [] ["print0"] (Option.NoArg set)
"terminate output with null"
where
set = Annex.setField (Option.name formatOption) "${file}\0"
seek :: [CommandSeek]
seek = [withField "format" formatconverter $ \f ->
seek = [withField formatOption formatconverter $ \f ->
withFilesInGit $ whenAnnexed $ start f]
where
formatconverter = maybe Nothing (Just . Utility.Format.gen)
formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
start format file (key, _) = do

View file

@ -18,17 +18,16 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
"make content of annexed files available"]
seek :: [CommandSeek]
seek = [withField "from" id $ \from -> withNumCopies $ \n ->
whenAnnexed $ start from n]
seek = [withField Command.Move.fromOption Remote.byName $ \from ->
withNumCopies $ \n -> whenAnnexed $ start from n]
start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
autoCopies key (<) numcopies $ do
case from of
Nothing -> go $ perform key
Just name -> do
Just src -> do
-- get --from = copy --from
src <- Remote.byName name
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key
where

117
Command/Log.hs Normal file
View file

@ -0,0 +1,117 @@
{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Log where
import qualified Data.Set as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import Data.Char
import Common.Annex
import Command
import qualified Logs.Location
import qualified Logs.Presence
import Annex.CatFile
import qualified Annex.Branch
import qualified Git
import Git.Command
import qualified Remote
import qualified Option
def :: [Command]
def = [withOptions [afterOption, maxcountOption] $
command "log" paramPaths seek "shows location log"]
afterOption :: Option
afterOption = Option.field [] "after" paramDate "show log after date"
maxcountOption :: Option
maxcountOption = Option.field ['n'] "max-count" paramNumber "limit number of logs displayed"
seek :: [CommandSeek]
seek = [withField afterOption return $ \afteropt ->
withField maxcountOption return $ \maxcount ->
withFilesInGit $ whenAnnexed $ start afteropt maxcount]
start :: Maybe String -> Maybe String -> FilePath -> (Key, Backend) -> CommandStart
start afteropt maxcount file (key, _) = do
showLog file =<< (readLog <$> getLog key ps)
stop
where
ps = concatMap (\(o, p) -> maybe [] p o)
[ (afteropt, \d -> [Param "--after", Param d])
, (maxcount, \c -> [Param "--max-count", Param c])
]
showLog :: FilePath -> [(POSIXTime, (Git.Ref, Git.Ref))] -> Annex ()
showLog file ps = do
zone <- liftIO getCurrentTimeZone
sets <- mapM (getset snd) ps
previous <- maybe (return genesis) (getset fst) (lastMaybe ps)
mapM_ (diff zone) $ zip sets (drop 1 sets ++ [previous])
where
genesis = (0, S.empty)
getset select (ts, refs) = do
s <- S.fromList <$> get (select refs)
return (ts, s)
get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
catObject ref
diff zone ((ts, new), (_, old)) = do
let time = show $ utcToLocalTime zone $
posixSecondsToUTCTime ts
output time True added
output time False removed
where
added = S.difference new old
removed = S.difference old new
output time present s = do
rs <- map (dropWhile isSpace) . lines <$>
Remote.prettyPrintUUIDs "log" (S.toList s)
liftIO $ mapM_ (putStrLn . format) rs
where
format r = unwords
[ if present then "+" else "-"
, time
, file
, "|"
, r
]
getLog :: Key -> [CommandParam] -> Annex [String]
getLog key ps = do
top <- fromRepo Git.workTree
p <- liftIO $ relPathCwdToFile top
let logfile = p </> Logs.Location.logFile key
inRepo $ pipeNullSplit $
[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
, Param "--boundary"
] ++ ps ++
[ Param $ show Annex.Branch.fullname
, Param "--"
, Param logfile
]
readLog :: [String] -> [(POSIXTime, (Git.Ref, Git.Ref))]
readLog = mapMaybe (parse . lines)
where
parse (ts:raw:[]) = Just (parseTimeStamp ts, parseRaw raw)
parse _ = Nothing
-- Parses something like ":100644 100644 oldsha newsha M"
parseRaw :: String -> (Git.Ref, Git.Ref)
parseRaw l = (Git.Ref oldsha, Git.Ref newsha)
where
ws = words l
oldsha = ws !! 2
newsha = ws !! 3
parseTimeStamp :: String -> POSIXTime
parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
parseTime defaultTimeLocale "%s"

View file

@ -14,35 +14,33 @@ import qualified Annex
import Annex.Content
import qualified Remote
import Annex.UUID
import qualified Option
def :: [Command]
def = [withOptions options $ command "move" paramPaths seek
"move content of files to/from another repository"]
fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "source remote"
fromOption = Option.field ['f'] "from" paramRemote "source remote"
toOption :: Option
toOption = fieldOption ['t'] "to" paramRemote "destination remote"
toOption = Option.field ['t'] "to" paramRemote "destination remote"
options :: [Option]
options = [fromOption, toOption]
seek :: [CommandSeek]
seek = [withField "to" id $ \to -> withField "from" id $ \from ->
withFilesInGit $ whenAnnexed $ start to from True]
seek = [withField toOption Remote.byName $ \to ->
withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start to from True]
start :: Maybe String -> Maybe String -> Bool -> FilePath -> (Key, Backend) -> CommandStart
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
start to from move file (key, _) = do
noAuto
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just name) -> do
dest <- Remote.byName name
toStart dest move file key
(Just name, Nothing) -> do
src <- Remote.byName name
fromStart src move file key
(Nothing, Just dest) -> toStart dest move file key
(Just src, Nothing) -> fromStart src move file key
(_ , _) -> error "only one of --from or --to can be specified"
where
noAuto = when move $ whenM (Annex.getState Annex.auto) $ error

View file

@ -61,7 +61,7 @@ syncRemotes rs = do
wanted
| null rs = good =<< available
| otherwise = listed
listed = mapM Remote.byName rs
listed = catMaybes <$> mapM (Remote.byName . Just) rs
available = filter nonspecial <$> Remote.enabledRemoteList
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote

View file

@ -27,6 +27,7 @@ import qualified Git.LsTree as LsTree
import qualified Backend
import qualified Remote
import qualified Annex.Branch
import qualified Option
import Annex.CatFile
def :: [Command]
@ -34,7 +35,7 @@ def = [withOptions [fromOption] $ command "unused" paramNothing seek
"look for unused file content"]
fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "remote to check for unused content"
fromOption = Option.field ['f'] "from" paramRemote "remote to check for unused content"
seek :: [CommandSeek]
seek = [withNothing $ start]
@ -42,7 +43,7 @@ seek = [withNothing $ start]
{- Finds unused content in the annex. -}
start :: CommandStart
start = do
from <- Annex.getField "from"
from <- Annex.getField $ Option.name fromOption
let (name, action) = case from of
Nothing -> (".", checkUnused)
Just "." -> (".", checkUnused)
@ -66,7 +67,7 @@ checkUnused = do
checkRemoteUnused :: String -> CommandPerform
checkRemoteUnused name = do
checkRemoteUnused' =<< Remote.byName name
checkRemoteUnused' =<< fromJust <$> Remote.byName (Just name)
next $ return True
checkRemoteUnused' :: Remote -> Annex ()

View file

@ -34,3 +34,6 @@ extractSha s
{- Size of a git sha. -}
shaSize :: Int
shaSize = 40
nullSha :: Ref
nullSha = Ref $ replicate shaSize '0'

View file

@ -103,14 +103,13 @@ calc_merge ch differ repo streamer = gendiff >>= go
- a line suitable for update_index that union merges the two sides of the
- diff. -}
mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String)
mergeFile info file h repo = case filter (/= nullsha) [Ref asha, Ref bsha] of
mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
[] -> return Nothing
(sha:[]) -> use sha
shas -> use =<< either return (hashObject repo . L.unlines) =<<
calcMerge . zip shas <$> mapM getcontents shas
where
[_colonmode, _bmode, asha, bsha, _status] = words info
nullsha = Ref $ replicate shaSize '0'
getcontents s = L.lines <$> catObject h s
use sha = return $ Just $ update_index_line sha file

View file

@ -18,6 +18,7 @@ import Types.TrustLevel
import qualified Annex
import qualified Remote
import qualified Limit
import qualified Option
import qualified Command.Add
import qualified Command.Unannex
@ -40,6 +41,7 @@ import qualified Command.Lock
import qualified Command.PreCommit
import qualified Command.Find
import qualified Command.Whereis
import qualified Command.Log
import qualified Command.Merge
import qualified Command.Status
import qualified Command.Migrate
@ -84,6 +86,7 @@ cmds = concat
, Command.DropUnused.def
, Command.Find.def
, Command.Whereis.def
, Command.Log.def
, Command.Merge.def
, Command.Status.def
, Command.Migrate.def
@ -93,7 +96,7 @@ cmds = concat
]
options :: [Option]
options = commonOptions ++
options = Option.common ++
[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
"override default number of copies"
, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
@ -114,7 +117,7 @@ options = commonOptions ++
"skip files with fewer copies"
, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
"skip files not using a key-value backend"
] ++ matcherOptions
] ++ Option.matcher
where
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
setgitconfig :: String -> Annex ()

View file

@ -13,14 +13,15 @@
module Logs.Presence (
LogStatus(..),
LogLine,
addLog,
readLog,
getLog,
parseLog,
showLog,
logNow,
compactLog,
currentLog,
LogLine
) where
import Data.Time.Clock.POSIX
@ -80,6 +81,10 @@ logNow s i = do
currentLog :: FilePath -> Annex [String]
currentLog file = map info . filterPresent <$> readLog file
{- Given a log, returns only the info that is are still in effect. -}
getLog :: String -> [String]
getLog = map info . filterPresent . parseLog
{- Returns the info from LogLines that are in effect. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent = filter (\l -> InfoPresent == status l) . compactLog

View file

@ -5,13 +5,13 @@
- Licensed under the GNU GPL version 3 or higher.
-}
module Options (
commonOptions,
matcherOptions,
flagOption,
fieldOption,
module Option (
common,
matcher,
flag,
field,
name,
ArgDescr(..),
Option,
OptDescr(..),
) where
@ -21,11 +21,10 @@ import System.Log.Logger
import Common.Annex
import qualified Annex
import Limit
import Types.Option
import Usage
commonOptions :: [Option]
commonOptions =
common :: [Option]
common =
[ Option [] ["force"] (NoArg (setforce True))
"allow actions that may lose annexed data"
, Option ['F'] ["fast"] (NoArg (setfast True))
@ -51,9 +50,9 @@ commonOptions =
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
setdebug = liftIO $ updateGlobalLogger rootLoggerName $
setLevel DEBUG
matcherOptions :: [Option]
matcherOptions =
matcher :: [Option]
matcher =
[ longopt "not" "negate next option"
, longopt "and" "both previous and next option must match"
, longopt "or" "either previous or next option must match"
@ -65,11 +64,16 @@ matcherOptions =
shortopt o = Option o [] $ NoArg $ addToken o
{- An option that sets a flag. -}
flagOption :: String -> String -> String -> Option
flagOption short flag description =
Option short [flag] (NoArg (Annex.setFlag flag)) description
flag :: String -> String -> String -> Option
flag short opt description =
Option short [opt] (NoArg (Annex.setFlag opt)) description
{- An option that sets a field. -}
fieldOption :: String -> String -> String -> String -> Option
fieldOption short field paramdesc description =
Option short [field] (ReqArg (Annex.setField field) paramdesc) description
field :: String -> String -> String -> String -> Option
field short opt paramdesc description =
Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
{- The flag or field name used for an option. -}
name :: Option -> String
name (Option _ o _ _) = Prelude.head o

View file

@ -94,14 +94,15 @@ enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
remoteMap :: Annex (M.Map UUID String)
remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
{- Looks up a remote by name. (Or by UUID.) Only finds currently configured
- git remotes. -}
byName :: String -> Annex (Remote)
byName n = do
{- When a name is specified, looks up the remote matching that name.
- (Or it can be a UUID.) Only finds currently configured git remotes. -}
byName :: Maybe String -> Annex (Maybe Remote)
byName Nothing = return Nothing
byName (Just n) = do
res <- byName' n
case res of
Left e -> error e
Right r -> return r
Right r -> return $ Just r
byName' :: String -> Annex (Either String Remote)
byName' "" = return $ Left "no remote specified"
byName' n = do

View file

@ -20,6 +20,7 @@ import qualified Git
import qualified Git.LsFiles as LsFiles
import qualified Git.CheckAttr
import qualified Limit
import qualified Option
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
seekHelper a params = do
@ -87,13 +88,13 @@ withKeys a params = return $ map (a . parse) params
where
parse p = fromMaybe (error "bad key") $ readKey p
{- Modifies a seek action using the value of a field, which is fed into
{- Modifies a seek action using the value of a field option, which is fed into
- a conversion function, and then is passed into the seek action.
- This ensures that the conversion function only runs once.
-}
withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek
withField field converter a ps = do
f <- converter <$> Annex.getField field
withField :: Option -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
withField option converter a ps = do
f <- converter =<< Annex.getField (Option.name option)
a f ps
withNothing :: CommandStart -> CommandSeek

View file

@ -11,7 +11,8 @@ module Types (
Key,
UUID(..),
Remote,
RemoteType
RemoteType,
Option
) where
import Annex
@ -19,6 +20,7 @@ import Types.Backend
import Types.Key
import Types.UUID
import Types.Remote
import Types.Option
type Backend = BackendA Annex
type Remote = RemoteA Annex

View file

@ -8,7 +8,6 @@
module Types.Command where
import Types
import Types.Option
{- A command runs in these stages.
-

View file

@ -72,6 +72,8 @@ paramUUID :: String
paramUUID = "UUID"
paramType :: String
paramType = "TYPE"
paramDate :: String
paramDate = "Date"
paramFormat :: String
paramFormat = "FORMAT"
paramKeyValue :: String

2
debian/changelog vendored
View file

@ -1,6 +1,8 @@
git-annex (3.20120106) UNRELEASED; urgency=low
* Support unescaped repository urls, like git does.
* log: New command that displays the location log for file,
showing each repository they were added to and removed from.
-- Joey Hess <joeyh@debian.org> Thu, 05 Jan 2012 14:29:30 -0400

2
debian/copyright vendored
View file

@ -2,7 +2,7 @@ Format: http://dep.debian.net/deps/dep5/
Source: native package
Files: *
Copyright: © 2010-2011 Joey Hess <joey@kitenet.net>
Copyright: © 2010-2012 Joey Hess <joey@kitenet.net>
License: GPL-3+
The full text of version 3 of the GPL is distributed as doc/GPL in
this package's source, or in /usr/share/common-licenses/GPL-3 on

View file

@ -273,6 +273,14 @@ subdirectories).
Displays a list of repositories known to contain the content of the
specified file or files.
* log [path ...]
Displays the location log for the specified file or files,
showing each repository they were added to ("+") and removed from ("-").
To only show location changes after a date, specify --after=date.
(The "date" can be any format accepted by git log, ie "last wednesday")
* status
Displays some statistics and other information, including how much data

View file

@ -13,6 +13,7 @@ import qualified Git.Construct
import CmdLine
import Command
import Annex.UUID
import qualified Option
import qualified Command.ConfigList
import qualified Command.InAnnex
@ -41,7 +42,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
}
options :: [OptDescr (Annex ())]
options = commonOptions ++
options = Option.common ++
[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
]
where