summaryrefslogtreecommitdiff
path: root/Upgrade.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-17 14:58:35 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-17 14:58:35 -0400
commitfd17f8e97390ffa72e90a4532c10f2848764c580 (patch)
tree3ff329e640a11b6c3ef62859896e7390dd23b1f7 /Upgrade.hs
parent9ed7e9be8f32b3795c5252641a11f3500a6dea28 (diff)
webapp: Check annex.version.
Diffstat (limited to 'Upgrade.hs')
-rw-r--r--Upgrade.hs16
1 files changed, 11 insertions, 5 deletions
diff --git a/Upgrade.hs b/Upgrade.hs
index 59cca3fe4..fe5dd887d 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -19,15 +19,21 @@ import qualified Upgrade.V2
import qualified Upgrade.V4
checkUpgrade :: Version -> Annex ()
-checkUpgrade v
- | v `elem` supportedVersions = noop
- | v `elem` autoUpgradeableVersions = unlessM (upgrade True) $
- err "Automatic upgrade failed!"
+checkUpgrade = maybe noop error <=< needsUpgrade
+
+needsUpgrade :: Version -> Annex (Maybe String)
+needsUpgrade v
+ | v `elem` supportedVersions = ok
+ | v `elem` autoUpgradeableVersions = ifM (upgrade True)
+ ( ok
+ , err "Automatic upgrade failed!"
+ )
| v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"
| otherwise = err "Upgrade git-annex."
where
- err msg = error $ "Repository version " ++ v ++
+ err msg = return $ Just $ "Repository version " ++ v ++
" is not supported. " ++ msg
+ ok = return Nothing
upgrade :: Bool -> Annex Bool
upgrade automatic = go =<< getVersion