git-annex/Command/List.hs

98 lines
2.6 KiB
Haskell
Raw Normal View History

{- git-annex command
-
- Copyright 2013 Joey Hess <id@joeyh.name>
2013-09-19 18:27:07 +00:00
- Copyright 2013 Antoine Beaupré
-
- Licensed under the GNU AGPL version 3 or higher.
-}
2013-09-19 18:16:28 +00:00
module Command.List where
import qualified Data.Set as S
2013-09-20 01:33:44 +00:00
import qualified Data.Map as M
import Data.Function
import Data.Ord
import Command
import Remote
import Logs.Trust
2013-09-20 01:33:44 +00:00
import Logs.UUID
import Annex.UUID
import Git.Types (RemoteName)
import Utility.Tuple
cmd :: Command
cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $
command "list" SectionQuery
"show which remotes contain files"
2015-07-11 00:46:48 +00:00
paramPaths (seek <$$> optParser)
2015-07-11 00:46:48 +00:00
data ListOptions = ListOptions
{ listThese :: CmdParams
, allRepos :: Bool
}
2013-09-20 01:33:44 +00:00
2015-07-11 00:46:48 +00:00
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
withFilesInGit
(commandAction . (whenAnnexed $ start list))
=<< workTreeItems (listThese o)
2015-07-11 00:46:48 +00:00
getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
getList o
| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
| otherwise = getRemotes
2013-09-20 01:33:44 +00:00
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) -> (,,)
2013-09-20 01:33:44 +00:00
<$> pure u
<*> pure (fromUUIDDesc d)
2013-09-20 01:33:44 +00:00
<*> lookupTrust u
return $ sortBy (comparing snd3) $
filter (\t -> thd3 t /= DeadTrusted) rs3
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
2015-07-11 00:46:48 +00:00
printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
start :: [(UUID, RemoteName, TrustLevel)] -> RawFilePath -> Key -> CommandStart
start l 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
2015-07-11 00:46:48 +00:00
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) = "_"