summaryrefslogtreecommitdiff
path: root/Remote.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-01 15:24:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-01 15:30:42 -0400
commitcdbcd6f495580ee927a85af0581661b486c8ef77 (patch)
tree87f3f882bb543bbed05147ce416805387a45082d /Remote.hs
parentceb887d82669b3ec694f31a899b59eefe0f5f352 (diff)
add web special remote
Generalized LocationLog to PresenceLog, and use a presence log to record urls for the web special remote.
Diffstat (limited to 'Remote.hs')
-rw-r--r--Remote.hs23
1 files changed, 22 insertions, 1 deletions
diff --git a/Remote.hs b/Remote.hs
index 1accabf6d..28c2e39cd 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -24,6 +24,7 @@ module Remote (
nameToUUID,
remotesWithUUID,
remotesWithoutUUID,
+ prettyPrintUUIDs,
remoteLog,
readRemoteLog,
@@ -34,7 +35,7 @@ module Remote (
prop_idempotent_configEscape
) where
-import Control.Monad (filterM)
+import Control.Monad (filterM, liftM2)
import Data.List
import qualified Data.Map as M
import Data.Maybe
@@ -54,6 +55,7 @@ import qualified Remote.S3
import qualified Remote.Bup
import qualified Remote.Directory
import qualified Remote.Rsync
+import qualified Remote.Web
import qualified Remote.Hook
remoteTypes :: [RemoteType Annex]
@@ -63,6 +65,7 @@ remoteTypes =
, Remote.Bup.remote
, Remote.Directory.remote
, Remote.Rsync.remote
+ , Remote.Web.remote
, Remote.Hook.remote
]
@@ -120,6 +123,24 @@ nameToUUID n = do
invertMap = M.fromList . map swap . M.toList
swap (a, b) = (b, a)
+{- Pretty-prints a list of UUIDs of remotes. -}
+prettyPrintUUIDs :: [UUID] -> Annex String
+prettyPrintUUIDs uuids = do
+ here <- getUUID =<< Annex.gitRepo
+ -- Show descriptions from the uuid log, falling back to remote names,
+ -- as some remotes may not be in the uuid log.
+ m <- liftM2 M.union uuidMap $
+ return . M.fromList . map (\r -> (uuid r, name r)) =<< genList
+ return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids
+ where
+ prettify m u here = base ++ ishere
+ where
+ base = if not $ null $ findlog m u
+ then u ++ " -- " ++ findlog m u
+ else u
+ ishere = if here == u then " <-- here" else ""
+ findlog m u = M.findWithDefault "" u m
+
{- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs