reorder repo parameters last

Many functions took the repo as their first parameter. Changing it
consistently to be the last parameter allows doing some useful things with
currying, that reduce boilerplate.

In particular, g <- gitRepo is almost never needed now, instead
use inRepo to run an IO action in the repo, and fromRepo to get
a value from the repo.

This also provides more opportunities to use monadic and applicative
combinators.
This commit is contained in:
Joey Hess 2011-11-08 15:34:10 -04:00
parent 2ff8915365
commit bf460a0a98
46 changed files with 338 additions and 390 deletions

View file

@ -102,15 +102,13 @@ bupSplitParams r buprepo k src = do
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
store r buprepo k = do
g <- gitRepo
let src = gitAnnexLocation g k
src <- fromRepo $ gitAnnexLocation k
params <- bupSplitParams r buprepo k (File src)
liftIO $ boolSystem "bup" params
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted r buprepo (cipher, enck) k = do
g <- gitRepo
let src = gitAnnexLocation g k
src <- fromRepo $ gitAnnexLocation k
params <- bupSplitParams r buprepo enck (Param "-")
liftIO $ catchBool $
withEncryptedHandle cipher (L.readFile src) $ \h ->
@ -147,7 +145,7 @@ checkPresent r bupr k
showAction $ "checking " ++ Git.repoDescribe r
ok <- onBupRemote bupr boolSystem "git" params
return $ Right ok
| otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine bupr params
| otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine params bupr
where
params =
[ Params "show-ref --quiet --verify"
@ -165,9 +163,10 @@ storeBupUUID u buprepo = do
>>! error "ssh failed"
else liftIO $ do
r' <- Git.configRead r
let olduuid = Git.configGet r' "annex.uuid" ""
when (olduuid == "") $ Git.run r' "config"
[Param "annex.uuid", Param v]
let olduuid = Git.configGet "annex.uuid" "" r'
when (olduuid == "") $
Git.run "config"
[Param "annex.uuid", Param v] r'
where
v = fromUUID u
@ -194,7 +193,7 @@ getBupUUID r u
| otherwise = liftIO $ do
ret <- try $ Git.configRead r
case ret of
Right r' -> return (toUUID $ Git.configGet r' "annex.uuid" "", r')
Right r' -> return (toUUID $ Git.configGet "annex.uuid" "" r', r')
Left _ -> return (NoUUID, r)
{- Converts a bup remote path spec into a Git.Repo. There are some

View file

@ -70,15 +70,13 @@ dirKey d k = d </> hashDirMixed k </> f </> f
store :: FilePath -> Key -> Annex Bool
store d k = do
g <- gitRepo
let src = gitAnnexLocation g k
src <- fromRepo $ gitAnnexLocation k
let dest = dirKey d k
liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted d (cipher, enck) k = do
g <- gitRepo
let src = gitAnnexLocation g k
src <- fromRepo $ gitAnnexLocation k
let dest = dirKey d enck
liftIO $ catchBool $ storeHelper dest $ encrypt src dest
where

View file

@ -35,19 +35,16 @@ remote = RemoteType {
list :: Annex [Git.Repo]
list = do
g <- gitRepo
let c = Git.configMap g
mapM (tweakurl c) $ Git.remotes g
c <- fromRepo Git.configMap
mapM (tweakurl c) =<< fromRepo Git.remotes
where
annexurl n = "remote." ++ n ++ ".annexurl"
tweakurl c r = do
let n = fromJust $ Git.repoRemoteName r
case M.lookup (annexurl n) c of
Nothing -> return r
Just url -> do
g <- gitRepo
r' <- liftIO $ Git.genRemote g url
return $ Git.repoRemoteNameSet r' n
Just url -> Git.repoRemoteNameSet n <$>
inRepo (Git.genRemote url)
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r u _ = do
@ -178,7 +175,7 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemote r key file
| not $ Git.repoIsUrl r = do
params <- rsyncParams r
rsyncOrCopyFile params (gitAnnexLocation r key) file
rsyncOrCopyFile params (gitAnnexLocation key r) file
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
| Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file
| otherwise = error "copying from non-ssh, non-http repo not supported"
@ -187,8 +184,7 @@ copyFromRemote r key file
copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
| not $ Git.repoIsUrl r = do
g <- gitRepo
let keysrc = gitAnnexLocation g key
keysrc <- fromRepo $ gitAnnexLocation key
params <- rsyncParams r
-- run copy from perspective of remote
liftIO $ onLocal r $ do
@ -197,8 +193,7 @@ copyToRemote r key
Annex.Content.saveState
return ok
| Git.repoIsSsh r = do
g <- gitRepo
let keysrc = gitAnnexLocation g key
keysrc <- fromRepo $ gitAnnexLocation key
rsyncHelper =<< rsyncParamsRemote r False key keysrc
| otherwise = error "copying to non-ssh repo not supported"

View file

@ -23,16 +23,16 @@ findSpecialRemotes s = do
return $ map construct $ remotepairs g
where
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
construct (k,_) = Git.repoRemoteNameFromKey Git.repoFromUnknown k
construct (k,_) = Git.repoRemoteNameFromKey k Git.repoFromUnknown
match k _ = startswith "remote." k && endswith (".annex-"++s) k
{- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
gitConfigSpecialRemote u c k v = do
g <- gitRepo
liftIO $ do
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
Git.run g "config" [Param (configsetting "annex-uuid"), Param $ fromUUID u]
set ("annex-"++k) v
set ("annex-uuid") (fromUUID u)
where
set a b = inRepo $ Git.run "config"
[Param (configsetting a), Param b]
remotename = fromJust (M.lookup "name" c)
configsetting s = "remote." ++ remotename ++ "." ++ s

View file

@ -98,14 +98,13 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
store :: String -> Key -> Annex Bool
store h k = do
g <- gitRepo
runHook h "store" k (Just $ gitAnnexLocation g k) $ return True
src <- fromRepo $ gitAnnexLocation k
runHook h "store" k (Just src) $ return True
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
g <- gitRepo
let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
src <- fromRepo $ gitAnnexLocation k
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
runHook h "store" enck (Just tmp) $ return True
retrieve :: String -> Key -> FilePath -> Annex Bool

View file

@ -90,15 +90,12 @@ rsyncKeyDir :: RsyncOpts -> Key -> String
rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k)
store :: RsyncOpts -> Key -> Annex Bool
store o k = do
g <- gitRepo
rsyncSend o k (gitAnnexLocation g k)
store o k = rsyncSend o k =<< fromRepo (gitAnnexLocation k)
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
g <- gitRepo
let f = gitAnnexLocation g k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
src <- fromRepo $ gitAnnexLocation k
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
rsyncSend o enck tmp
retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool
@ -151,9 +148,9 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial"
- up trees for rsync. -}
withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
withRsyncScratchDir a = do
g <- gitRepo
pid <- liftIO getProcessID
let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid
t <- fromRepo gitAnnexTmpDir
let tmp = t </> "rsynctmp" </> show pid
nuke tmp
liftIO $ createDirectoryIfMissing True tmp
res <- a tmp

View file

@ -112,8 +112,8 @@ s3Setup u c = handlehost $ M.lookup "host" c
store :: Remote Annex -> Key -> Annex Bool
store r k = s3Action r False $ \(conn, bucket) -> do
g <- gitRepo
res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k
dest <- fromRepo $ gitAnnexLocation k
res <- liftIO $ storeHelper (conn, bucket) r k dest
s3Bool res
storeEncrypted :: Remote Annex -> (Cipher, Key) -> Key -> Annex Bool
@ -121,8 +121,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
-- To get file size of the encrypted content, have to use a temp file.
-- (An alternative would be chunking to to a constant size.)
withTmp enck $ \tmp -> do
g <- gitRepo
let f = gitAnnexLocation g k
f <- fromRepo $ gitAnnexLocation k
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
s3Bool res

View file

@ -27,7 +27,7 @@ remote = RemoteType {
-- (If the web should cease to exist, remove this module and redistribute
-- a new release to the survivors by carrier pigeon.)
list :: Annex [Git.Repo]
list = return [Git.repoRemoteNameSet Git.repoFromUnknown "web"]
list = return [Git.repoRemoteNameSet "web" Git.repoFromUnknown]
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
gen r _ _ =