2012-01-06 19:40:04 +00:00
{- git - annex command
-
2023-11-10 16:37:01 +00:00
- Copyright 2012 - 2023 Joey Hess < id @ joeyh . name >
2012-01-06 19:40:04 +00:00
-
2019-03-13 19:48:14 +00:00
- Licensed under the GNU AGPL version 3 or higher .
2012-01-06 19:40:04 +00:00
- }
2023-11-10 20:17:15 +00:00
{- # LANGUAGE OverloadedStrings, BangPatterns # -}
2023-04-11 18:27:22 +00:00
2012-01-06 19:40:04 +00:00
module Command.Log where
import qualified Data.Set as S
2012-01-07 22:13:12 +00:00
import qualified Data.Map as M
2015-05-10 18:45:55 +00:00
import Data.Char
2012-01-06 19:40:04 +00:00
import Data.Time.Clock.POSIX
import Data.Time
2023-04-11 18:27:22 +00:00
import qualified Data.ByteString.Char8 as B8
2020-11-02 20:31:28 +00:00
import qualified System.FilePath.ByteString as P
2023-11-10 20:17:15 +00:00
import Control.Concurrent.Async
2012-01-06 19:40:04 +00:00
import Command
2013-08-29 22:51:22 +00:00
import Logs
2016-07-17 19:15:08 +00:00
import Logs.Location
2023-11-10 20:17:15 +00:00
import Logs.UUID
import qualified Logs.Presence.Pure as PLog
2023-11-13 18:46:51 +00:00
import Logs.Trust.Pure ( parseTrustLog )
import Logs.UUIDBased ( simpleMap )
2023-11-10 16:37:01 +00:00
import qualified Annex
2012-01-06 19:40:04 +00:00
import qualified Annex.Branch
import qualified Remote
2023-11-10 16:37:01 +00:00
import qualified Git
import Git.Log
2023-11-10 20:17:15 +00:00
import Git.CatFile
2023-11-13 18:46:51 +00:00
import Types.TrustLevel
2023-11-10 20:17:15 +00:00
import Utility.DataUnits
import Utility.HumanTime
2012-01-06 22:54:48 +00:00
2016-07-17 19:15:08 +00:00
data LogChange = Added | Removed
type Outputter = LogChange -> POSIXTime -> [ UUID ] -> Annex ()
2012-01-07 22:13:12 +00:00
2015-07-08 16:33:27 +00:00
cmd :: Command
2023-05-04 15:28:27 +00:00
cmd = withAnnexOptions [ jsonOptions , annexedMatchingOptions ] $
2015-07-08 19:08:02 +00:00
command " log " SectionQuery " shows location log "
2015-07-13 14:44:51 +00:00
paramPaths ( seek <$$> optParser )
2012-01-06 21:24:03 +00:00
2015-07-13 14:44:51 +00:00
data LogOptions = LogOptions
{ logFiles :: CmdParams
2016-07-17 19:15:08 +00:00
, allOption :: Bool
2023-11-10 20:17:15 +00:00
, sizesOfOption :: Maybe ( DeferredParse UUID )
2023-11-13 17:07:22 +00:00
, sizesOption :: Bool
2023-11-13 17:15:07 +00:00
, totalSizesOption :: Bool
2023-11-14 18:00:06 +00:00
, intervalOption :: Maybe Duration
, receivedOption :: Bool
2023-11-14 18:56:58 +00:00
, gnuplotOption :: Bool
2016-03-29 18:39:16 +00:00
, rawDateOption :: Bool
2023-11-10 20:17:15 +00:00
, bytesOption :: Bool
2015-07-13 14:44:51 +00:00
, gourceOption :: Bool
, passthruOptions :: [ CommandParam ]
}
2012-01-07 22:13:12 +00:00
2015-07-13 14:44:51 +00:00
optParser :: CmdParamsDesc -> Parser LogOptions
optParser desc = LogOptions
<$> cmdParams desc
2016-07-17 19:15:08 +00:00
<*> switch
( long " all "
<> short 'A'
<> help " display location log changes to all files "
)
2023-11-10 20:17:15 +00:00
<*> optional ( ( parseUUIDOption <$> strOption
( long " sizesof "
<> metavar ( paramRemote ` paramOr ` paramDesc ` paramOr ` paramUUID )
<> help " display history of sizes of this repository "
<> completeRemotes
) ) )
2023-11-13 17:07:22 +00:00
<*> switch
( long " sizes "
<> help " display history of sizes of all repositories "
)
2023-11-13 17:15:07 +00:00
<*> switch
( long " totalsizes "
<> help " display history of total sizes of all repositories "
)
2023-11-10 20:17:15 +00:00
<*> optional ( option ( eitherReader parseDuration )
2023-11-14 15:45:16 +00:00
( long " interval " <> metavar paramTime
<> help " minimum time between displays of changed size "
2023-11-10 20:17:15 +00:00
) )
2023-11-14 18:00:06 +00:00
<*> switch
( long " received "
<> help " display received data per interval rather than repository sizes "
)
2023-11-14 18:56:58 +00:00
<*> switch
( long " gnuplot "
<> help " graph the history "
)
2016-03-29 18:39:16 +00:00
<*> switch
( long " raw-date "
<> help " display seconds from unix epoch "
)
2023-11-10 20:17:15 +00:00
<*> switch
( long " bytes "
<> help " display sizes in bytes "
)
2015-07-13 14:44:51 +00:00
<*> switch
( long " gource "
<> help " format output for gource "
)
<*> ( concat <$> many passthru )
2012-11-12 05:05:04 +00:00
where
2015-07-13 14:44:51 +00:00
passthru :: Parser [ CommandParam ]
passthru = datepassthru " since "
<|> datepassthru " after "
<|> datepassthru " until "
<|> datepassthru " before "
<|> ( mkpassthru " max-count " <$> strOption
( long " max-count " <> metavar paramNumber
<> help " limit number of logs displayed "
) )
datepassthru n = mkpassthru n <$> strOption
( long n <> metavar paramDate
<> help ( " show log " ++ n ++ " date " )
)
mkpassthru n v = [ Param ( " -- " ++ n ) , Param v ]
2012-01-07 22:13:12 +00:00
2015-07-13 14:44:51 +00:00
seek :: LogOptions -> CommandSeek
2021-12-27 19:44:15 +00:00
seek o = ifM ( null <$> Annex . Branch . getUnmergedRefs )
2023-11-10 20:17:15 +00:00
( maybe ( pure Nothing ) ( Just <$$> getParsed ) ( sizesOfOption o ) >>= \ case
Just u -> sizeHistoryInfo ( Just u ) o
2023-11-13 17:15:07 +00:00
Nothing -> if sizesOption o || totalSizesOption o
2023-11-13 17:07:22 +00:00
then sizeHistoryInfo Nothing o
else go
2023-11-10 20:17:15 +00:00
, giveup " This repository is read-only, and there are unmerged git-annex branches, which prevents displaying location log changes. (Set annex.merge-annex-branches to false to ignore the unmerged git-annex branches.) "
)
where
ww = WarnUnmatchLsFiles " log "
go = do
2021-12-27 19:44:15 +00:00
m <- Remote . uuidDescriptions
zone <- liftIO getCurrentTimeZone
2023-05-04 16:36:31 +00:00
outputter <- mkOutputter m zone o <$> jsonOutputEnabled
2021-12-27 19:44:15 +00:00
let seeker = AnnexedFileSeeker
2023-12-06 17:04:32 +00:00
{ startAction = const $ start o outputter
2021-12-27 19:44:15 +00:00
, checkContentPresent = Nothing
-- the way this uses the location log would not be
-- helped by precaching the current value
, usesLocationLog = False
}
case ( logFiles o , allOption o ) of
( fs , False ) -> withFilesInGitAnnex ww seeker
=<< workTreeItems ww fs
( [] , True ) -> commandAction ( startAll o outputter )
( _ , True ) -> giveup " Cannot specify both files and --all "
2016-07-17 19:15:08 +00:00
2023-05-04 16:36:31 +00:00
start :: LogOptions -> ( ActionItem -> SeekInput -> Outputter ) -> SeekInput -> RawFilePath -> Key -> CommandStart
start o outputter si file key = do
2016-07-17 19:15:08 +00:00
( changes , cleanup ) <- getKeyLog key ( passthruOptions o )
2023-05-04 16:36:31 +00:00
let ai = mkActionItem ( file , key )
showLogIncremental ( outputter ai si ) changes
2016-03-29 18:27:38 +00:00
void $ liftIO cleanup
2012-01-06 19:40:04 +00:00
stop
2023-05-04 16:36:31 +00:00
startAll :: LogOptions -> ( ActionItem -> SeekInput -> Outputter ) -> CommandStart
2016-07-17 19:15:08 +00:00
startAll o outputter = do
2023-11-10 16:37:01 +00:00
( changes , cleanup ) <- getGitLogAnnex [] ( passthruOptions o )
2023-05-04 16:36:31 +00:00
showLog ( \ ai -> outputter ai ( SeekInput [] ) ) changes
2016-07-17 19:15:08 +00:00
void $ liftIO cleanup
stop
{- Displays changes made. Only works when all the RefChanges are for the
- same key . The method is to compare each value with the value
- after it in the list , which is the old version of the value .
-
- This ncessarily buffers the whole list , so does not stream .
- But , the number of location log changes for a single key tends to be
- fairly small .
-
- This minimizes the number of reads from git ; each logged value is read
- only once .
-
- This also generates subtly better output when the git - annex branch
- got diverged .
- }
2023-11-10 16:37:01 +00:00
showLogIncremental :: Outputter -> [ RefChange Key ] -> Annex ()
2016-07-17 19:15:08 +00:00
showLogIncremental outputter ps = do
2012-01-06 22:54:48 +00:00
sets <- mapM ( getset newref ) ps
previous <- maybe ( return genesis ) ( getset oldref ) ( lastMaybe ps )
2016-07-17 19:15:08 +00:00
let l = sets ++ [ previous ]
let changes = map ( \ ( ( t , new ) , ( _ , old ) ) -> ( t , new , old ) )
( zip l ( drop 1 l ) )
sequence_ $ compareChanges outputter changes
2012-11-12 05:05:04 +00:00
where
genesis = ( 0 , S . empty )
getset select change = do
2016-07-17 19:15:08 +00:00
s <- S . fromList <$> loggedLocationsRef ( select change )
2012-11-12 05:05:04 +00:00
return ( changetime change , s )
2016-07-17 19:15:08 +00:00
{- Displays changes made. Streams, and can display changes affecting
- different keys , but does twice as much reading of logged values
- as showLogIncremental . - }
2023-11-10 16:37:01 +00:00
showLog :: ( ActionItem -> Outputter ) -> [ RefChange Key ] -> Annex ()
2016-07-17 19:15:08 +00:00
showLog outputter cs = forM_ cs $ \ c -> do
2023-11-10 16:37:01 +00:00
let ai = mkActionItem ( changed c )
2016-07-17 19:15:08 +00:00
new <- S . fromList <$> loggedLocationsRef ( newref c )
old <- S . fromList <$> loggedLocationsRef ( oldref c )
2023-05-04 16:36:31 +00:00
sequence_ $ compareChanges ( outputter ai )
2016-07-17 19:15:08 +00:00
[ ( changetime c , new , old ) ]
2023-05-04 16:36:31 +00:00
mkOutputter :: UUIDDescMap -> TimeZone -> LogOptions -> Bool -> ActionItem -> SeekInput -> Outputter
mkOutputter m zone o jsonenabled ai si
| jsonenabled = jsonOutput m ai si
| rawDateOption o = normalOutput lookupdescription ai rawTimeStamp
| gourceOption o = gourceOutput lookupdescription ai
2023-11-10 20:17:15 +00:00
| otherwise = normalOutput lookupdescription ai ( showTimeStamp zone rfc822DateFormat )
2016-07-17 19:15:08 +00:00
where
2019-01-01 19:39:45 +00:00
lookupdescription u = maybe ( fromUUID u ) ( fromUUIDDesc ) ( M . lookup u m )
2012-01-07 22:13:12 +00:00
2023-05-04 16:36:31 +00:00
normalOutput :: ( UUID -> String ) -> ActionItem -> ( POSIXTime -> String ) -> Outputter
normalOutput lookupdescription ai formattime logchange ts us = do
2023-04-11 18:27:22 +00:00
qp <- coreQuotePath <$> Annex . getGitConfig
liftIO $ mapM_ ( B8 . putStrLn . quote qp . format ) us
2012-11-12 05:05:04 +00:00
where
2016-03-29 18:39:16 +00:00
time = formattime ts
2016-07-17 19:15:08 +00:00
addel = case logchange of
Added -> " + "
Removed -> " - "
2023-05-04 16:36:31 +00:00
format u = UnquotedString addel <> " "
<> UnquotedString time <> " "
<> actionItemDesc ai <> " | "
<> UnquotedByteString ( fromUUID u ) <> " -- "
<> UnquotedString ( lookupdescription u )
jsonOutput :: UUIDDescMap -> ActionItem -> SeekInput -> Outputter
jsonOutput m ai si logchange ts us = do
showStartMessage $ StartMessage " log " ai si
maybeShowJSON $ JSONChunk
[ ( " logged " , case logchange of
Added -> " addition "
Removed -> " removal " )
, ( " date " , rawTimeStamp ts )
]
void $ Remote . prettyPrintUUIDsDescs " locations " m us
showEndOk
2012-01-07 22:13:12 +00:00
2023-05-04 16:36:31 +00:00
gourceOutput :: ( UUID -> String ) -> ActionItem -> Outputter
gourceOutput lookupdescription ai logchange ts us =
2012-01-07 22:13:12 +00:00
liftIO $ mapM_ ( putStrLn . intercalate " | " . format ) us
2012-11-12 05:05:04 +00:00
where
time = takeWhile isDigit $ show ts
2016-07-17 19:15:08 +00:00
addel = case logchange of
Added -> " A "
Removed -> " M "
2023-05-04 16:36:31 +00:00
format u =
[ time
, lookupdescription u
, addel
, decodeBS ( noquote ( actionItemDesc ai ) )
]
2012-01-06 19:40:04 +00:00
2016-07-17 19:15:08 +00:00
{- Generates a display of the changes.
2012-01-07 04:45:01 +00:00
- Uses a formatter to generate a display of items that are added and
2012-01-07 04:11:15 +00:00
- removed . - }
2016-07-17 19:15:08 +00:00
compareChanges :: Ord a => ( LogChange -> POSIXTime -> [ a ] -> b ) -> [ ( POSIXTime , S . Set a , S . Set a ) ] -> [ b ]
compareChanges format changes = concatMap diff changes
2012-11-12 05:05:04 +00:00
where
2023-05-04 16:36:31 +00:00
diff ( ts , new , old )
| new == old = []
| otherwise =
[ format Added ts $ S . toList $ S . difference new old
, format Removed ts $ S . toList $ S . difference old new
]
2012-01-07 04:11:15 +00:00
2016-07-17 19:15:08 +00:00
{- Streams the git log for a given key's location log file.
2012-01-07 04:15:01 +00:00
-
- This is complicated by git log using paths relative to the current
- directory , even when looking at files in a different branch . A wacky
- relative path to the log file has to be used .
-
- The --remove-empty is a significant optimisation. It relies on location
- log files never being deleted in normal operation . Letting git stop
- once the location log file is gone avoids it checking all the way back
- to commit 0 to see if it used to exist , so generally speeds things up a
- * lot * for newish files . - }
2023-11-10 16:37:01 +00:00
getKeyLog :: Key -> [ CommandParam ] -> Annex ( [ RefChange Key ] , IO Bool )
2016-07-17 19:15:08 +00:00
getKeyLog key os = do
Clean up handling of git directory and git worktree.
Baked into the code was an assumption that a repository's git directory
could be determined by adding ".git" to its work tree (or nothing for bare
repos). That fails when core.worktree, or GIT_DIR and GIT_WORK_TREE are
used to separate the two.
This was attacked at the type level, by storing the gitdir and worktree
separately, so Nothing for the worktree means a bare repo.
A complication arose because we don't learn where a repository is bare
until its configuration is read. So another Location type handles
repositories that have not had their config read yet. I am not entirely
happy with this being a Location type, rather than representing them
entirely separate from the Git type. The new code is not worse than the
old, but better types could enforce more safety.
Added support for core.worktree. Overriding it with -c isn't supported
because it's not really clear what to do if a git repo's config is read, is
not bare, and is then overridden to bare. What is the right git directory
in this case? I will worry about this if/when someone has a use case for
overriding core.worktree with -c. (See Git.Config.updateLocation)
Also removed and renamed some functions like gitDir and workTree that
misused git's terminology.
One minor regression is known: git annex add in a bare repository does not
print a nice error message, but runs git ls-files in a way that fails
earlier with a less nice error message. This is because before --work-tree
was always passed to git commands, even in a bare repo, while now it's not.
2012-05-18 20:38:26 +00:00
top <- fromRepo Git . repoPath
2020-11-02 20:31:28 +00:00
p <- liftIO $ relPathCwdToFile top
2015-01-28 21:17:26 +00:00
config <- Annex . getGitConfig
2020-11-02 20:31:28 +00:00
let logfile = p P .</> locationLogFile config key
2023-11-10 16:37:01 +00:00
getGitLogAnnex [ fromRawFilePath logfile ] ( Param " --remove-empty " : os )
2016-07-17 19:15:08 +00:00
2023-11-10 16:37:01 +00:00
getGitLogAnnex :: [ FilePath ] -> [ CommandParam ] -> Annex ( [ RefChange Key ] , IO Bool )
getGitLogAnnex fs os = do
2020-02-14 19:22:48 +00:00
config <- Annex . getGitConfig
2023-11-10 16:37:01 +00:00
let fileselector = locationLogFileKey config . toRawFilePath
inRepo $ getGitLog Annex . Branch . fullname fs os fileselector
2012-01-07 03:43:18 +00:00
2023-11-10 20:17:15 +00:00
showTimeStamp :: TimeZone -> String -> POSIXTime -> String
showTimeStamp zone format = formatTime defaultTimeLocale format
2016-03-29 18:27:38 +00:00
. utcToZonedTime zone . posixSecondsToUTCTime
2023-05-04 15:53:38 +00:00
rawTimeStamp :: POSIXTime -> String
rawTimeStamp t = filter ( /= 's' ) ( show t )
2023-11-10 20:17:15 +00:00
sizeHistoryInfo :: ( Maybe UUID ) -> LogOptions -> Annex ()
sizeHistoryInfo mu o = do
2023-11-13 17:07:22 +00:00
uuidmap <- getuuidmap
2023-11-10 20:17:15 +00:00
zone <- liftIO getCurrentTimeZone
2023-11-14 18:56:58 +00:00
dispst <- displaystart uuidmap zone
2023-11-10 20:17:15 +00:00
( l , cleanup ) <- getlog
g <- Annex . gitRepo
liftIO $ catObjectStream g $ \ feeder closer reader -> do
tid <- async $ do
forM_ l $ \ c ->
feeder ( ( changed c , changetime c ) , newref c )
closer
2023-11-13 18:46:51 +00:00
go reader mempty mempty mempty uuidmap dispst
2023-11-10 20:17:15 +00:00
wait tid
void $ liftIO cleanup
where
-- Go through the log of the git-annex branch in reverse,
-- and in date order, and pick out changes to location log files
-- and to the trust log.
getlog = do
config <- Annex . getGitConfig
let fileselector = \ f -> let f' = toRawFilePath f in
case locationLogFileKey config f' of
Just k -> Just ( Right k )
Nothing
| f' == trustLog -> Just ( Left () )
| otherwise -> Nothing
inRepo $ getGitLog Annex . Branch . fullname []
[ Param " --date-order "
, Param " --reverse "
]
fileselector
2023-11-13 18:46:51 +00:00
go reader sizemap locmap trustlog uuidmap dispst = reader >>= \ case
2023-11-10 20:17:15 +00:00
Just ( ( Right k , t ) , Just logcontent ) -> do
let ! newlog = parselocationlog logcontent uuidmap
let ! ( sizemap' , locmap' ) = case M . lookup k locmap of
Nothing -> addnew k sizemap locmap newlog
Just v -> update k sizemap locmap v newlog
2023-11-13 18:46:51 +00:00
dispst' <- displaysizes dispst trustlog uuidmap sizemap' t
go reader sizemap' locmap' trustlog uuidmap dispst'
2023-11-10 20:17:15 +00:00
Just ( ( Left () , t ) , Just logcontent ) -> do
2023-11-13 18:46:51 +00:00
let ! trustlog' = trustlog <> parseTrustLog logcontent
dispst' <- displaysizes dispst trustlog' uuidmap sizemap t
go reader sizemap locmap trustlog' uuidmap dispst'
2023-11-10 20:17:15 +00:00
Just ( _ , Nothing ) ->
2023-11-13 18:46:51 +00:00
go reader sizemap locmap trustlog uuidmap dispst
2023-11-10 20:17:15 +00:00
Nothing ->
2023-11-14 18:56:58 +00:00
displayend dispst
2023-11-10 20:17:15 +00:00
-- Known uuids are stored in this map, and when uuids are stored in the
-- state, it's a value from this map. This avoids storing multiple
-- copies of the same uuid in memory.
getuuidmap = do
2023-11-13 17:07:22 +00:00
( us , ds ) <- unzip . M . toList <$> uuidDescMap
return $ M . fromList ( zip us ( zip us ds ) )
2023-11-10 20:17:15 +00:00
-- Parses a location log file, and replaces the logged uuid
-- with one from the uuidmap.
parselocationlog logcontent uuidmap =
map replaceuuid $ PLog . parseLog logcontent
where
replaceuuid ll =
let ! u = toUUID $ PLog . fromLogInfo $ PLog . info ll
2023-11-13 17:07:22 +00:00
! ushared = maybe u fst $ M . lookup u uuidmap
2023-11-10 20:17:15 +00:00
in ll { PLog . info = PLog . LogInfo ( fromUUID ushared ) }
presentlocs = map ( toUUID . PLog . fromLogInfo . PLog . info )
. PLog . filterPresent
-- Since the git log is being traversed in date order, commits
-- from different branches can appear one after the other, and so
-- the newlog is not necessarily the complete state known at that
-- time across all git-annex repositories.
--
-- This combines the new location log with what has been
-- accumulated so far, which is equivilant to merging together
-- all git-annex branches at that point in time.
update k sizemap locmap ( oldlog , oldlocs ) newlog =
( updatesize ( updatesize sizemap sz ( S . toList addedlocs ) )
( negate sz ) ( S . toList removedlocs )
, M . insert k ( combinedlog , combinedlocs ) locmap
)
where
sz = ksz k
combinedlog = PLog . compactLog ( oldlog ++ newlog )
combinedlocs = S . fromList ( presentlocs combinedlog )
addedlocs = S . difference combinedlocs oldlocs
2023-11-14 18:00:06 +00:00
removedlocs
| receivedOption o = S . empty
| otherwise = S . difference oldlocs combinedlocs
2023-11-10 20:17:15 +00:00
addnew k sizemap locmap newlog =
( updatesize sizemap ( ksz k ) locs
, M . insert k ( newlog , S . fromList locs ) locmap
)
where
locs = presentlocs newlog
ksz k = fromMaybe 0 ( fromKey keySize k )
updatesize sizemap _ [] = sizemap
updatesize sizemap sz ( l : ls ) =
updatesize ( M . insertWith ( + ) l sz sizemap ) sz ls
epoch = toEnum 0
2023-11-14 18:56:58 +00:00
displaystart uuidmap zone
| gnuplotOption o = do
file <- ( </> )
<$> fromRepo ( fromRawFilePath . gitAnnexDir )
<*> pure " gnuplot "
liftIO $ putStrLn $ " Generating gnuplot script in " ++ file
h <- liftIO $ openFile file WriteMode
liftIO $ mapM_ ( hPutStrLn h )
[ " set datafile separator ',' "
, " set timefmt \ " %Y-%m-%dT%H:%M:%S \ " "
, " set xdata time "
, " set xtics out "
, " set ytics format '%s%c' "
, " set tics front "
, " set key spacing 1 font \ " ,8 \ " "
]
unless ( sizesOption o ) $
liftIO $ hPutStrLn h " set key off "
liftIO $ hPutStrLn h " $data << EOD "
liftIO $ hPutStrLn h $ if sizesOption o
then uuidmapheader
else csvheader [ " value " ]
let endaction = do
mapM_ ( hPutStrLn h )
[ " EOD "
, " "
, " plot for [i=2: " ++ show ncols ++ " :1] \ \ "
, " \ " $data \ " using 1:(sum [col=i: " ++ show ncols ++ " ] column(col)) \ \ "
, " title columnheader(i) \ \ "
, if receivedOption o
then " with boxes "
else " with filledcurves x1 "
]
hFlush h
putStrLn $ " Running gnuplot... "
void $ liftIO $ boolSystem " gnuplot "
[ Param " -p " , File file ]
return ( dispst h endaction )
| sizesOption o = do
liftIO $ putStrLn uuidmapheader
return ( dispst stdout noop )
| otherwise = return ( dispst stdout noop )
where
dispst fileh endaction =
( zone , False , epoch , Nothing , mempty , fileh , endaction )
ncols
| sizesOption o = 1 + length ( M . elems uuidmap )
| otherwise = 2
uuidmapheader = csvheader $
map ( fromUUIDDesc . snd ) ( M . elems uuidmap )
displaysizes ( zone , displayedyet , prevt , prevoutput , prevsizemap , h , endaction ) trustlog uuidmap sizemap t
2023-11-14 18:00:06 +00:00
| t - prevt >= dt && changedoutput = do
2023-11-14 18:56:58 +00:00
displayts zone t output h
return ( zone , True , t , Just output , sizemap' , h , endaction )
| t < prevt = return ( zone , displayedyet , t , Just output , prevsizemap , h , endaction )
| otherwise = return ( zone , displayedyet , prevt , prevoutput , prevsizemap , h , endaction )
2023-11-10 20:17:15 +00:00
where
2023-11-13 17:07:22 +00:00
output = intercalate " , " ( map showsize sizes )
2023-11-10 20:17:15 +00:00
us = case mu of
Just u -> [ u ]
Nothing -> M . keys uuidmap
2023-11-13 17:15:07 +00:00
sizes
2023-11-14 18:00:06 +00:00
| totalSizesOption o = [ sum ( M . elems sizedisplaymap ) ]
| otherwise = map ( \ u -> fromMaybe 0 ( M . lookup u sizedisplaymap ) ) us
dt = maybe 1 durationToPOSIXTime ( intervalOption o )
changedoutput
| receivedOption o =
any ( /= 0 ) sizes
|| prevoutput /= Just output
| otherwise =
( displayedyet || any ( /= 0 ) sizes )
&& ( prevoutput /= Just output )
sizedisplaymap
| receivedOption o =
M . unionWith posminus sizemap' prevsizemap
| otherwise = sizemap'
posminus a b = max 0 ( a - b )
2023-11-10 20:17:15 +00:00
2023-11-13 18:46:51 +00:00
-- A verison of sizemap where uuids that are currently dead
-- have 0 size.
sizemap' = M . mapWithKey zerodead sizemap
zerodead u v = case M . lookup u ( simpleMap trustlog ) of
Just DeadTrusted -> 0
_ -> v
2023-11-14 18:56:58 +00:00
displayts zone t output h = do
hPutStrLn h ( ts ++ " , " ++ output )
hFlush h
2023-11-10 20:17:15 +00:00
where
2023-11-14 18:56:58 +00:00
ts = if rawDateOption o && not ( gnuplotOption o )
2023-11-10 20:17:15 +00:00
then rawTimeStamp t
else showTimeStamp zone " %Y-%m-%dT%H:%M:%S " t
2023-11-14 18:56:58 +00:00
displayend dispst @ ( _ , _ , _ , _ , _ , _ , endaction ) = do
displayendsizes dispst
endaction
displayendsizes ( zone , _ , _ , Just output , _ , h , _ ) = do
2023-11-10 21:37:55 +00:00
now <- getPOSIXTime
2023-11-14 18:56:58 +00:00
displayts zone now output h
2023-11-10 20:17:15 +00:00
displayendsizes _ = return ()
showsize n
2023-11-14 18:56:58 +00:00
| bytesOption o || gnuplotOption o = show n
2023-11-10 20:17:15 +00:00
| otherwise = roughSize storageUnits True n
2023-11-13 17:07:22 +00:00
csvquote s
| ',' ` elem ` s || '"' ` elem ` s =
'"' : concatMap escquote s ++ [ '"' ]
| otherwise = s
where
escquote '"' = " \ " \ " "
escquote c = [ c ]
2023-11-14 18:56:58 +00:00
csvheader l = intercalate " , " ( " date " : map csvquote l )