lift to IO

This commit is contained in:
Joey Hess 2010-10-15 19:32:56 -04:00
parent 946a7f3f21
commit e67887d98b
2 changed files with 11 additions and 6 deletions

View file

@ -26,12 +26,16 @@ import qualified Annex
import UUID
backend = Backend {
name = mustProvide,
getKey = mustProvide,
storeFileKey = dummyStore,
retrieveKeyFile = copyKeyFile,
removeKey = dummyRemove,
hasKey = checkKeyFile
}
mustProvide = error "must provide this field"
{- Storing a key is a no-op. -}
dummyStore :: FilePath -> Key -> Annex (Bool)
dummyStore file key = return True
@ -74,11 +78,12 @@ copyKeyFile key file = do
cantfind = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
ppuuids <- prettyPrintUUIDs uuids
error $ "no available git remotes have: " ++
(keyFile key) ++ (uuidlist uuids)
uuidlist [] = ""
uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++
prettyPrintUUIDs uuids
(keyFile key) ++
if (0 < length uuids)
then "\nIt has been seen before in these repositories:\n" ++ ppuuids
else ""
{- Tries to copy a file from a remote, exception on error. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO ()

View file

@ -91,7 +91,7 @@ reposByUUID repos uuids = do
{- Pretty-prints a list of UUIDs
- TODO: use lookup file to really show pretty names. -}
prettyPrintUUIDs :: [UUID] -> String
prettyPrintUUIDs :: [UUID] -> Annex String
prettyPrintUUIDs uuids =
unwords $ map (\u -> "\tUUID "++u++"\n") uuids
return $ unwords $ map (\u -> "\tUUID "++u++"\n") uuids