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

converted Info

Browse source
This commit is contained in:
Joey Hess 2015-07-11 10:41:52 -04:00
parent 9ad20c2869
commit 215f636bb3
2 changed files with 63 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

4
CmdLine/GitAnnex.hs
View file

@ -63,7 +63,7 @@ import qualified Command.List
--import qualified Command.Log --import qualified Command.Log
import qualified Command.Merge import qualified Command.Merge
import qualified Command.ResolveMerge import qualified Command.ResolveMerge
--import qualified Command.Info import qualified Command.Info
--import qualified Command.Status --import qualified Command.Status
import qualified Command.Migrate import qualified Command.Migrate
import qualified Command.Uninit import qualified Command.Uninit
@ -190,7 +190,7 @@ cmds =
-- , Command.Log.cmd -- , Command.Log.cmd
, Command.Merge.cmd , Command.Merge.cmd
, Command.ResolveMerge.cmd , Command.ResolveMerge.cmd
-- , Command.Info.cmd , Command.Info.cmd
-- , Command.Status.cmd -- , Command.Status.cmd
, Command.Migrate.cmd , Command.Migrate.cmd
, Command.Map.cmd , Command.Map.cmd

111
Command/Info.hs
View file

@ -70,80 +70,94 @@ data StatInfo = StatInfo
, referencedData :: Maybe KeyData , referencedData :: Maybe KeyData
, repoData :: M.Map UUID KeyData , repoData :: M.Map UUID KeyData
, numCopiesStats :: Maybe NumCopiesStats , numCopiesStats :: Maybe NumCopiesStats
, infoOptions :: InfoOptions
} }
emptyStatInfo :: StatInfo emptyStatInfo :: InfoOptions -> StatInfo
emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing
-- a state monad for running Stats in -- a state monad for running Stats in
type StatState = StateT StatInfo Annex type StatState = StateT StatInfo Annex
cmd :: Command cmd :: Command
cmd = noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $ cmd = noCommit $ dontCheck repoExists $ withGlobalOptions (jsonOption : annexedMatchingOptions) $
command "info" SectionQuery command "info" SectionQuery
"shows information about the specified item or the repository as a whole" "shows information about the specified item or the repository as a whole"
(paramRepeating paramItem) (withParams seek) (paramRepeating paramItem) (seek <$$> optParser)
seek :: CmdParams -> CommandSeek data InfoOptions = InfoOptions
seek = withWords start { infoFor :: CmdParams
, bytesOption :: Bool
}
start :: [String] -> CommandStart optParser :: CmdParamsDesc -> Parser InfoOptions
start [] = do optParser desc = InfoOptions
globalInfo <$> cmdParams desc
<*> switch
( long "bytes"
<> help "display file sizes in bytes"
)
seek :: InfoOptions -> CommandSeek
seek o = withWords (start o) (infoFor o)
start :: InfoOptions -> [String] -> CommandStart
start o [] = do
globalInfo o
stop stop
start ps = do start o ps = do
mapM_ itemInfo ps mapM_ (itemInfo o) ps
stop stop
globalInfo :: Annex () globalInfo :: InfoOptions -> Annex ()
globalInfo = do globalInfo o = do
stats <- selStats global_fast_stats global_slow_stats stats <- selStats global_fast_stats global_slow_stats
showCustom "info" $ do showCustom "info" $ do
evalStateT (mapM_ showStat stats) emptyStatInfo evalStateT (mapM_ showStat stats) (emptyStatInfo o)
return True return True
itemInfo :: String -> Annex () itemInfo :: InfoOptions -> String -> Annex ()
itemInfo p = ifM (isdir p) itemInfo o p = ifM (isdir p)
( dirInfo p ( dirInfo o p
, do , do
v <- Remote.byName' p v <- Remote.byName' p
case v of case v of
Right r -> remoteInfo r Right r -> remoteInfo o r
Left _ -> do Left _ -> do
v' <- Remote.nameToUUID' p v' <- Remote.nameToUUID' p
case v' of case v' of
Right u -> uuidInfo u Right u -> uuidInfo o u
Left _ -> maybe noinfo (fileInfo p) Left _ -> maybe noinfo (fileInfo o p)
=<< isAnnexLink p =<< isAnnexLink p
) )
where where
isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid" noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid"
dirInfo :: FilePath -> Annex () dirInfo :: InfoOptions -> FilePath -> Annex ()
dirInfo dir = showCustom (unwords ["info", dir]) $ do dirInfo o dir = showCustom (unwords ["info", dir]) $ do
stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats) stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats)
evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir evalStateT (mapM_ showStat stats) =<< getDirStatInfo o dir
return True return True
where where
tostats = map (\s -> s dir) tostats = map (\s -> s dir)
fileInfo :: FilePath -> Key -> Annex () fileInfo :: InfoOptions -> FilePath -> Key -> Annex ()
fileInfo file k = showCustom (unwords ["info", file]) $ do fileInfo o file k = showCustom (unwords ["info", file]) $ do
evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)
return True return True
remoteInfo :: Remote -> Annex () remoteInfo :: InfoOptions -> Remote -> Annex ()
remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do remoteInfo o r = showCustom (unwords ["info", Remote.name r]) $ do
i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r i <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r
l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r)) l <- selStats (remote_fast_stats r ++ i) (uuid_slow_stats (Remote.uuid r))
evalStateT (mapM_ showStat l) emptyStatInfo evalStateT (mapM_ showStat l) (emptyStatInfo o)
return True return True
uuidInfo :: UUID -> Annex () uuidInfo :: InfoOptions -> UUID -> Annex ()
uuidInfo u = showCustom (unwords ["info", fromUUID u]) $ do uuidInfo o u = showCustom (unwords ["info", fromUUID u]) $ do
l <- selStats [] ((uuid_slow_stats u)) l <- selStats [] ((uuid_slow_stats u))
evalStateT (mapM_ showStat l) emptyStatInfo evalStateT (mapM_ showStat l) (emptyStatInfo o)
return True return True
selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats :: [Stat] -> [Stat] -> Annex [Stat]
@ -299,7 +313,7 @@ local_annex_keys = stat "local annex keys" $ json show $
local_annex_size :: Stat local_annex_size :: Stat
local_annex_size = simpleStat "local annex size" $ local_annex_size = simpleStat "local annex size" $
lift . showSizeKeys =<< cachedPresentData showSizeKeys =<< cachedPresentData
remote_annex_keys :: UUID -> Stat remote_annex_keys :: UUID -> Stat
remote_annex_keys u = stat "remote annex keys" $ json show $ remote_annex_keys u = stat "remote annex keys" $ json show $
@ -307,7 +321,7 @@ remote_annex_keys u = stat "remote annex keys" $ json show $
remote_annex_size :: UUID -> Stat remote_annex_size :: UUID -> Stat
remote_annex_size u = simpleStat "remote annex size" $ remote_annex_size u = simpleStat "remote annex size" $
lift . showSizeKeys =<< cachedRemoteData u showSizeKeys =<< cachedRemoteData u
known_annex_files :: Stat known_annex_files :: Stat
known_annex_files = stat "annexed files in working tree" $ json show $ known_annex_files = stat "annexed files in working tree" $ json show $
@ -315,7 +329,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $
known_annex_size :: Stat known_annex_size :: Stat
known_annex_size = simpleStat "size of annexed files in working tree" $ known_annex_size = simpleStat "size of annexed files in working tree" $
lift . showSizeKeys =<< cachedReferencedData showSizeKeys =<< cachedReferencedData
tmp_size :: Stat tmp_size :: Stat
tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir
@ -324,7 +338,7 @@ bad_data_size :: Stat
bad_data_size = staleSize "bad keys size" gitAnnexBadDir bad_data_size = staleSize "bad keys size" gitAnnexBadDir
key_size :: Key -> Stat key_size :: Key -> Stat
key_size k = simpleStat "size" $ lift $ showSizeKeys $ foldKeys [k] key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k]
key_name :: Key -> Stat key_name :: Key -> Stat
key_name k = simpleStat "key" $ pure $ key2file k key_name k = simpleStat "key" $ pure $ key2file k
@ -340,7 +354,7 @@ bloom_info = simpleStat "bloom filter size" $ do
-- Two bloom filters are used at the same time when running -- Two bloom filters are used at the same time when running
-- git-annex unused, so double the size of one. -- git-annex unused, so double the size of one.
sizer <- lift mkSizer sizer <- mkSizer
size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$> size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$>
lift bloomBitsHashes lift bloomBitsHashes
@ -372,10 +386,10 @@ transfer_list = stat desc $ nojson $ lift $ do
] ]
disk_size :: Stat disk_size :: Stat
disk_size = simpleStat "available local disk space" $ lift $ disk_size = simpleStat "available local disk space" $
calcfree calcfree
<$> (annexDiskReserve <$> Annex.getGitConfig) <$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
<*> inRepo (getDiskFree . gitAnnexDir) <*> (lift $ inRepo $ getDiskFree . gitAnnexDir)
<*> mkSizer <*> mkSizer
where where
calcfree reserve (Just have) sizer = unwords calcfree reserve (Just have) sizer = unwords
@ -409,7 +423,7 @@ numcopies_stats = stat "numcopies stats" $ json fmt $
reposizes_stats :: Stat reposizes_stats :: Stat
reposizes_stats = stat desc $ nojson $ do reposizes_stats = stat desc $ nojson $ do
sizer <- lift mkSizer sizer <- mkSizer
l <- map (\(u, kd) -> (u, sizer storageUnits True (sizeKeys kd))) l <- map (\(u, kd) -> (u, sizer storageUnits True (sizeKeys kd)))
. sortBy (flip (comparing (sizeKeys . snd))) . sortBy (flip (comparing (sizeKeys . snd)))
. M.toList . M.toList
@ -466,14 +480,14 @@ cachedNumCopiesStats = numCopiesStats <$> get
cachedRepoData :: StatState (M.Map UUID KeyData) cachedRepoData :: StatState (M.Map UUID KeyData)
cachedRepoData = repoData <$> get cachedRepoData = repoData <$> get
getDirStatInfo :: FilePath -> Annex StatInfo getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo
getDirStatInfo dir = do getDirStatInfo o dir = do
fast <- Annex.getState Annex.fast fast <- Annex.getState Annex.fast
matcher <- Limit.getMatcher matcher <- Limit.getMatcher
(presentdata, referenceddata, numcopiesstats, repodata) <- (presentdata, referenceddata, numcopiesstats, repodata) <-
Command.Unused.withKeysFilesReferencedIn dir initial Command.Unused.withKeysFilesReferencedIn dir initial
(update matcher fast) (update matcher fast)
return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) o
where where
initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty) initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty)
update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) = update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =
@ -530,7 +544,7 @@ updateNumCopiesStats file (NumCopiesStats m) locs = do
let !ret = NumCopiesStats m' let !ret = NumCopiesStats m'
return ret return ret
showSizeKeys :: KeyData -> Annex String showSizeKeys :: KeyData -> StatState String
showSizeKeys d = do showSizeKeys d = do
sizer <- mkSizer sizer <- mkSizer
return $ total sizer ++ missingnote return $ total sizer ++ missingnote
@ -550,7 +564,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
onsize 0 = nostat onsize 0 = nostat
onsize size = stat label $ onsize size = stat label $
json (++ aside "clean up with git-annex unused") $ do json (++ aside "clean up with git-annex unused") $ do
sizer <- lift mkSizer sizer <- mkSizer
return $ sizer storageUnits False size return $ sizer storageUnits False size
keysizes keys = do keysizes keys = do
dir <- lift $ fromRepo dirspec dir <- lift $ fromRepo dirspec
@ -563,11 +577,8 @@ aside s = " (" ++ s ++ ")"
multiLine :: [String] -> String multiLine :: [String] -> String
multiLine = concatMap (\l -> "\n\t" ++ l) multiLine = concatMap (\l -> "\n\t" ++ l)
mkSizer :: Annex ([Unit] -> Bool -> ByteSize -> String) mkSizer :: StatState ([Unit] -> Bool -> ByteSize -> String)
mkSizer = ifM (getOptionFlag bytesOption) mkSizer = ifM (bytesOption . infoOptions <$> get)
( return (const $ const show) ( return (const $ const show)
, return roughSize , return roughSize
) )
bytesOption :: Option
bytesOption = flagOption [] "bytes" "display file sizes in bytes"