Maybe reduction pass 2

This commit is contained in:
Joey Hess 2011-05-15 12:25:58 -04:00
parent cad0e1c8b7
commit 3e15a8a791
4 changed files with 33 additions and 51 deletions

View file

@ -91,20 +91,12 @@ prepCommand Command { cmdseek = seek } params = do
{- Runs a command through the start, perform and cleanup stages -}
doCommand :: CommandStart -> CommandCleanup
doCommand start = do
s <- start
case s of
Nothing -> return True
Just perform -> do
p <- perform
case p of
Nothing -> do
showEndFail
return False
Just cleanup -> do
c <- cleanup
if c then showEndOk else showEndFail
return c
doCommand = start
where
start = stage $ maybe (return True) perform
perform = stage $ maybe (showEndFail >> return False) cleanup
cleanup = stage $ \r -> showEndResult r >> return r
stage a b = b >>= a
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file

View file

@ -210,9 +210,9 @@ assertUrl repo action =
" not supported"
configBare :: Repo -> Bool
configBare repo = case Map.lookup "core.bare" $ config repo of
Just v -> configTrue v
Nothing -> error $ "it is not known if git repo " ++
configBare repo = maybe unknown configTrue $ Map.lookup "core.bare" $ config repo
where
unknown = error $ "it is not known if git repo " ++
repoDescribe repo ++
" is a bare repository; config not read"
@ -260,11 +260,10 @@ workTreeFile repo@(Repo { location = Dir d }) file = do
where
-- normalize both repo and file, so that repo
-- will be substring of file
absrepo = case (absNormPath "/" d) of
Just f -> addTrailingPathSeparator f
Nothing -> error $ "bad repo" ++ repoDescribe repo
absrepo = maybe bad addTrailingPathSeparator $ absNormPath "/" d
absfile c = maybe file id $ secureAbsNormPath c file
inrepo f = absrepo `isPrefixOf` f
bad = error $ "bad repo" ++ repoDescribe repo
workTreeFile repo _ = assertLocal repo $ error "internal"
{- Path of an URL repo. -}
@ -627,23 +626,19 @@ expandTilde = expandt True
{- Finds the current git repository, which may be in a parent directory. -}
repoFromCwd :: IO Repo
repoFromCwd = do
cwd <- getCurrentDirectory
top <- seekUp cwd isRepoTop
case top of
-- repoFromAbsPath is not used to avoid looking for
-- "dir.git" directories.
(Just dir) -> return $ newFrom $ Dir dir
Nothing -> error "Not in a git repository."
repoFromCwd = getCurrentDirectory >>= seekUp isRepoTop >>= maybe norepo makerepo
where
makerepo = return . newFrom . Dir
norepo = error "Not in a git repository."
seekUp :: FilePath -> (FilePath -> IO Bool) -> IO (Maybe FilePath)
seekUp dir want = do
seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
seekUp want dir = do
ok <- want dir
if ok
then return (Just dir)
else case (parentDir dir) of
"" -> return Nothing
d -> seekUp d want
d -> seekUp want d
isRepoTop :: FilePath -> IO Bool
isRepoTop dir = do

View file

@ -45,6 +45,10 @@ showEndOk = verbose $ liftIO $ putStrLn "ok"
showEndFail :: Annex ()
showEndFail = verbose $ liftIO $ putStrLn "\nfailed"
showEndResult :: Bool -> Annex ()
showEndResult True = showEndOk
showEndResult False = showEndFail
showErr :: (Show a) => a -> Annex ()
showErr e = warning $ "git-annex: " ++ show e

View file

@ -54,21 +54,14 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
cost = cost r + encryptedRemoteCostAdj
}
where
store k = do
v <- cipherKey c k
case v of
Nothing -> (storeKey r) k
Just x -> storeKeyEncrypted x k
retrieve k f = do
v <- cipherKey c k
case v of
Nothing -> (retrieveKeyFile r) k f
Just x -> retrieveKeyFileEncrypted x f
withkey a k = do
v <- cipherKey c k
case v of
Nothing -> a k
Just (_, k') -> a k'
store k = cip k >>= maybe
(storeKey r k)
(\x -> storeKeyEncrypted x k)
retrieve k f = cip k >>= maybe
(retrieveKeyFile r k f)
(\x -> retrieveKeyFileEncrypted x f)
withkey a k = cip k >>= maybe (a k) (a . snd)
cip = cipherKey c
{- Gets encryption Cipher. The decrypted Cipher is cached in the Annex
- state. -}
@ -87,10 +80,8 @@ remoteCipher c = maybe expensive cached =<< Annex.getState Annex.cipher
{- Gets encryption Cipher, and encrypted version of Key. -}
cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
cipherKey Nothing _ = return Nothing
cipherKey (Just c) k = do
cipher <- remoteCipher c
case cipher of
Just ciphertext -> do
cipherKey (Just c) k = remoteCipher c >>= maybe (return Nothing) encrypt
where
encrypt ciphertext = do
k' <- liftIO $ encryptKey ciphertext k
return $ Just (ciphertext, k')
Nothing -> return Nothing