b223988e22
--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
102 lines
2.7 KiB
Haskell
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) = "_"
|