implemented uuid.log
This commit is contained in:
parent
5de102d5b9
commit
46ac19a51d
2 changed files with 44 additions and 8 deletions
50
UUID.hs
50
UUID.hs
|
@ -11,7 +11,8 @@ module UUID (
|
||||||
prepUUID,
|
prepUUID,
|
||||||
genUUID,
|
genUUID,
|
||||||
reposByUUID,
|
reposByUUID,
|
||||||
prettyPrintUUIDs
|
prettyPrintUUIDs,
|
||||||
|
describeUUID
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
@ -19,8 +20,10 @@ import Maybe
|
||||||
import List
|
import List
|
||||||
import System.Cmd.Utils
|
import System.Cmd.Utils
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import qualified Data.Map as M
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
import Types
|
import Types
|
||||||
|
import Locations
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
|
||||||
type UUID = String
|
type UUID = String
|
||||||
|
@ -29,7 +32,7 @@ configkey="annex.uuid"
|
||||||
|
|
||||||
{- Generates a UUID. There is a library for this, but it's not packaged,
|
{- Generates a UUID. There is a library for this, but it's not packaged,
|
||||||
- so use the command line tool. -}
|
- so use the command line tool. -}
|
||||||
genUUID :: Annex UUID
|
genUUID :: IO UUID
|
||||||
genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
|
genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
|
||||||
|
|
||||||
{- Looks up a repo's UUID. May return "" if none is known.
|
{- Looks up a repo's UUID. May return "" if none is known.
|
||||||
|
@ -66,7 +69,7 @@ prepUUID = do
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
if ("" == u)
|
if ("" == u)
|
||||||
then do
|
then do
|
||||||
uuid <- genUUID
|
uuid <- liftIO $ genUUID
|
||||||
setConfig configkey uuid
|
setConfig configkey uuid
|
||||||
else return ()
|
else return ()
|
||||||
|
|
||||||
|
@ -89,9 +92,42 @@ reposByUUID repos uuids = do
|
||||||
u <- getUUID r
|
u <- getUUID r
|
||||||
return $ isJust $ elemIndex u uuids
|
return $ isJust $ elemIndex u uuids
|
||||||
|
|
||||||
{- Pretty-prints a list of UUIDs
|
{- Pretty-prints a list of UUIDs -}
|
||||||
- TODO: use lookup file to really show pretty names. -}
|
|
||||||
prettyPrintUUIDs :: [UUID] -> Annex String
|
prettyPrintUUIDs :: [UUID] -> Annex String
|
||||||
prettyPrintUUIDs uuids =
|
prettyPrintUUIDs uuids = do
|
||||||
return $ unwords $ map (\u -> "\tUUID "++u++"\n") uuids
|
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"
|
||||||
|
|
|
@ -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,
|
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.)
|
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
|
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
|
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
|
file when asking for the repository to be made available. The file format
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue