git-annex/Command/List.hs
Joey Hess b223988e22
remove --backend from global options
--backend is no longer a global option, and is only accepted by commands
that actually need it.

Three commands that used to support backend but don't any longer are
watch, webapp, and assistant. It would be possible to make them support it,
but I doubt anyone used the option with these. And in the case of webapp
and assistant, the option was handled inconsistently, only taking affect
when the command is run with an existing git-annex repo, not when it
creates a new one.

Also, renamed GlobalOption etc to AnnexOption. Because there are many
options of this type that are not actually global (any more) and get
added to commands that need them.

Sponsored-by: Kevin Mueller on Patreon
2022-06-29 13:33:25 -04:00

102 lines
2.7 KiB
Haskell

{- git-annex command
-
- Copyright 2013 Joey Hess <id@joeyh.name>
- Copyright 2013 Antoine Beaupré
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.List where
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Function
import Data.Ord
import Command
import Remote
import Logs.Trust
import Logs.UUID
import Annex.UUID
import Git.Types (RemoteName)
import Utility.Tuple
cmd :: Command
cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $
command "list" SectionQuery
"show which remotes contain files"
paramPaths (seek <$$> optParser)
data ListOptions = ListOptions
{ listThese :: CmdParams
, allRepos :: Bool
}
optParser :: CmdParamsDesc -> Parser ListOptions
optParser desc = ListOptions
<$> cmdParams desc
<*> switch
( long "allrepos"
<> help "show all repositories, not only remotes"
)
seek :: ListOptions -> CommandSeek
seek o = do
list <- getList o
printHeader list
let seeker = AnnexedFileSeeker
{ startAction = start list
, checkContentPresent = Nothing
, usesLocationLog = True
}
withFilesInGitAnnex ww seeker =<< workTreeItems ww (listThese o)
where
ww = WarnUnmatchLsFiles
getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
getList o
| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
| otherwise = getRemotes
where
getRemotes = do
rs <- remoteList
ts <- mapM (lookupTrust . uuid) rs
hereu <- getUUID
heretrust <- lookupTrust hereu
let l = (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts
return $ filter (\(_, _, t) -> t /= DeadTrusted) l
getAllUUIDs = do
rs <- M.toList <$> uuidDescMap
rs3 <- forM rs $ \(u, d) -> (,,)
<$> pure u
<*> pure (fromUUIDDesc d)
<*> lookupTrust u
return $ sortBy (comparing snd3) $
filter (\t -> thd3 t /= DeadTrusted) rs3
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart
start l _si file key = do
ls <- S.fromList <$> keyLocations key
liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
stop
type Present = Bool
lheader :: [(RemoteName, TrustLevel)] -> String
lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
where
formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
pipes = flip replicate '|'
trust UnTrusted = " (untrusted)"
trust _ = ""
format :: [(TrustLevel, Present)] -> RawFilePath -> String
format remotes file = thereMap ++ " " ++ fromRawFilePath file
where
thereMap = concatMap there remotes
there (UnTrusted, True) = "x"
there (_, True) = "X"
there (_, False) = "_"