diff options
Diffstat (limited to 'Command/Log.hs')
| -rw-r--r-- | Command/Log.hs | 54 |
1 files changed, 35 insertions, 19 deletions
diff --git a/Command/Log.hs b/Command/Log.hs index 3489c5ab0..51bdbc74c 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -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") . |