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

log --after=date

Browse source
This commit is contained in:
Joey Hess 2012-01-06 17:24:03 -04:00
parent 47646d44b7
commit 9fb5f3edc7
5 changed files with 44 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

54
Command/Log.hs
View file

@ -23,29 +23,39 @@ import qualified Annex.Branch
import qualified Git
import Git.Command
import qualified Remote
import qualified Option
def :: [Command]
def = [command "log" paramPaths seek "shows location log"]
def = [withOptions [afterOption] $
command "log" paramPaths seek "shows location log"]
afterOption :: Option
afterOption = Option.field [] "after" paramDate "show log after date"
seek :: [CommandSeek]
seek = [withFilesInGit $ whenAnnexed $ start]
seek = [withField afterOption return $ \afteropt ->
withFilesInGit $ whenAnnexed $ start afteropt]
start :: FilePath -> (Key, Backend) -> CommandStart
start file (key, _) = do
start :: Maybe String -> FilePath -> (Key, Backend) -> CommandStart
start afteropt file (key, _) = do
showStart file ""
showLog =<< readLog key
let ps = case afteropt of
Nothing -> []
Just date -> [Param "--after", Param date]
showLog =<< (readLog <$> getLog key ps)
stop
showLog :: [(POSIXTime, Git.Ref)] -> Annex ()
showLog :: [(POSIXTime, (Git.Ref, Git.Ref))] -> Annex ()
showLog ps = do
zone <- liftIO getCurrentTimeZone
sets <- mapM getset ps
sets <- mapM (getset snd) ps
previous <- maybe (return genesis) (getset fst) (lastMaybe ps)
liftIO $ putStrLn ""
mapM_ (diff zone) $ zip sets (drop 1 sets ++ genesis)
mapM_ (diff zone) $ zip sets (drop 1 sets ++ [previous])
where
genesis = [(0, S.empty)]
getset (ts, ref) = do
s <- S.fromList <$> get ref
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
@ -68,27 +78,33 @@ showLog ps = do
, r
]
getLog :: Key -> Annex [String]
getLog key = do
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
inRepo $ pipeNullSplit $
[ Params "log -z --pretty=format:%ct --raw --abbrev=40"
, Param $ show Annex.Branch.fullname
, Param "--boundary"
] ++ ps ++
[ Param $ show Annex.Branch.fullname
, Param "--"
, Param logfile
]
readLog :: Key -> Annex [(POSIXTime, Git.Ref)]
readLog key = mapMaybe (parse . lines) <$> getLog key
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
parseRaw l = Git.Ref $ words l !! 3
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") .