summaryrefslogtreecommitdiff
path: root/Command/Log.hs
blob: 0e0c8d3a0c2d7332d1b1ee968b6e2519f205cae5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
{- 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
import qualified Annex

data RefChange = RefChange 
	{ changetime :: POSIXTime
	, oldref :: Git.Ref
	, newref :: Git.Ref
	}

def :: [Command]
def = [withOptions options $
	command "log" paramPaths seek "shows location log"]

options :: [Option]
options = map odate ["since", "after", "until", "before"] ++
	[ Option.field ['n'] "max-count" paramNumber
		"limit number of logs displayed"
	]
	where
		odate n = Option.field [] n paramDate $
			"show log " ++ n ++ " date"

seek :: [CommandSeek]
seek = [withValue (concat <$> mapM getoption options) $ \os ->
	withFilesInGit $ whenAnnexed $ start os]
	where
		getoption o = maybe [] (use o) <$>
			Annex.getField (Option.name o)
		use o v = [Param ("--" ++ Option.name o), Param v]

start :: [CommandParam] -> FilePath -> (Key, Backend) -> CommandStart
start os file (key, _) = do
	showLog file =<< readLog <$> getLog key os
	stop

showLog :: FilePath -> [RefChange] -> Annex ()
showLog file ps = do
	zone <- liftIO getCurrentTimeZone
	sets <- mapM (getset newref) ps
	previous <- maybe (return genesis) (getset oldref) (lastMaybe ps)
	mapM_ (diff file zone) $ zip sets (drop 1 sets ++ [previous])
	where
		genesis = (0, S.empty)
		getset select change = do
			s <- S.fromList <$> get (select change)
			return (changetime change, s)
		get ref = map toUUID . Logs.Presence.getLog . L.unpack <$>
			catObject ref

diff :: FilePath -> TimeZone -> ((POSIXTime, S.Set UUID), (POSIXTime, S.Set UUID)) -> Annex ()
diff file zone ((ts, new), (_, old)) = output True added >> output False removed
	where
		added = S.difference new old
		removed = S.difference old new
		time = showTimeStamp zone ts
		output present s = do
			rs <- map (dropWhile isSpace) . lines <$>
				Remote.prettyPrintUUIDs "log" (S.toList s)
			liftIO $ mapM_ (putStrLn . format) rs
				where
					addel = if present then "+" else "-"
					format r = unwords
						[ addel, time, file, "|", r ]

getLog :: Key -> [CommandParam] -> Annex [String]
getLog key os = 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"
		] ++ os ++
		[ Param $ show Annex.Branch.fullname
		, Param "--"
		, Param logfile
		]

readLog :: [String] -> [RefChange]
readLog = mapMaybe (parse . lines)
	where
		parse (ts:raw:[]) = let (old, new) = parseRaw raw in
			Just RefChange
				{ changetime = parseTimeStamp ts
				, oldref = old
				, newref = new
				}
		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"

showTimeStamp :: TimeZone -> POSIXTime -> String
showTimeStamp zone = show . utcToLocalTime zone . posixSecondsToUTCTime