summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--UUID.hs50
-rw-r--r--git-annex.mdwn2
2 files changed, 44 insertions, 8 deletions
diff --git a/UUID.hs b/UUID.hs
index 3653eeec4..8cdee43de 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -11,7 +11,8 @@ module UUID (
prepUUID,
genUUID,
reposByUUID,
- prettyPrintUUIDs
+ prettyPrintUUIDs,
+ describeUUID
) where
import Control.Monad.State
@@ -19,8 +20,10 @@ import Maybe
import List
import System.Cmd.Utils
import System.IO
+import qualified Data.Map as M
import qualified GitRepo as Git
import Types
+import Locations
import qualified Annex
type UUID = String
@@ -29,7 +32,7 @@ configkey="annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
-genUUID :: Annex UUID
+genUUID :: IO UUID
genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
{- Looks up a repo's UUID. May return "" if none is known.
@@ -66,7 +69,7 @@ prepUUID = do
u <- getUUID g
if ("" == u)
then do
- uuid <- genUUID
+ uuid <- liftIO $ genUUID
setConfig configkey uuid
else return ()
@@ -89,9 +92,42 @@ reposByUUID repos uuids = do
u <- getUUID r
return $ isJust $ elemIndex u uuids
-{- Pretty-prints a list of UUIDs
- - TODO: use lookup file to really show pretty names. -}
+{- Pretty-prints a list of UUIDs -}
prettyPrintUUIDs :: [UUID] -> Annex String
-prettyPrintUUIDs uuids =
- return $ unwords $ map (\u -> "\tUUID "++u++"\n") uuids
+prettyPrintUUIDs uuids = do
+ m <- uuidMap
+ return $ unwords $ map (\u -> " "++(prettify m u)++"\n") uuids
+ where
+ prettify m u =
+ if (0 < (length $ findlog m u))
+ then u ++ " -- " ++ (findlog m u)
+ else u
+ findlog m u = M.findWithDefault "" u m
+
+{- Records a description for a uuid in the uuidLog. -}
+describeUUID :: UUID -> String -> Annex ()
+describeUUID uuid desc = do
+ m <- uuidMap
+ let m' = M.insert uuid desc m
+ log <- uuidLog
+ liftIO $ writeFile log $ serialize m'
+ where
+ serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
+{- Read and parse the uuidLog into a Map -}
+uuidMap :: Annex (M.Map UUID String)
+uuidMap = do
+ log <- uuidLog
+ s <- liftIO $ catch (readFile log) (\error -> return "")
+ return $ M.fromList $ map (\l -> pair l) $ lines s
+ where
+ pair l =
+ if (1 < (length $ words l))
+ then ((words l) !! 0, unwords $ drop 1 $ words l)
+ else ("", "")
+
+{- Filename of uuid.log. -}
+uuidLog :: Annex String
+uuidLog = do
+ g <- Annex.gitRepo
+ return $ (gitStateDir g) ++ "uuid.log"
diff --git a/git-annex.mdwn b/git-annex.mdwn
index 21649bfd1..1261a196f 100644
--- a/git-annex.mdwn
+++ b/git-annex.mdwn
@@ -109,7 +109,7 @@ Repositories record their UUID and the date when they get or drop
a file's content. (Git is configured to use a union merge for this file,
so the lines may be in arbitrary order, but it will never conflict.)
-The optional file `.git-annex/uuid.map` can be created to add a description
+The optional file `.git-annex/uuid.log` can be created to add a description
to a UUID. If git-annex needs a file from a repository and it cannot find
the repository amoung the remotes, it will use the description from this
file when asking for the repository to be made available. The file format