avoid using MonadFail in ParseDuration

There's no instance for Either String, so that makes it not as useful as
it could be, so instead just return an Either String.

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 62f6672ed14722fb460a2e49db3def75fb29fd0d..10cb613a36036b9e0fa1cebec739789cdce78a52 100644 (file)
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -286,7 +286,7 @@ keyMatchingOptions' =
                <> help "match files the repository wants to drop"
                <> hidden
                )
-       , globalSetter Limit.addAccessedWithin $ option (str >>= parseDuration)
+       , globalSetter Limit.addAccessedWithin $ option (eitherReader parseDuration)
                ( long "accessedwithin"
                <> metavar paramTime
                <> help "match files accessed within a time interval"
@@ -403,7 +403,7 @@ jobsOption =
 
 timeLimitOption :: [GlobalOption]
 timeLimitOption = 
-       [ globalSetter Limit.addTimeLimit $ option (str >>= parseDuration)
+       [ globalSetter Limit.addTimeLimit $ option (eitherReader parseDuration)
                ( long "time-limit" <> short 'T' <> metavar paramTime
                <> help "stop after the specified amount of time"
                <> hidden

diff --git a/Command/Assistant.hs b/Command/Assistant.hs
index 9377357f2b96670f8d05af982097d77e5f549ed9..9c82d48e5fe5bb09eee5dd0c525faf64e968a503 100644 (file)
--- a/Command/Assistant.hs
+++ b/Command/Assistant.hs
@@ -39,7 +39,7 @@ optParser _ = AssistantOptions
                ( long "autostart"
                <> help "start in known repositories"
                )
-       <*> optional (option (str >>= parseDuration)
+       <*> optional (option (eitherReader parseDuration)
                ( long "startdelay" <> metavar paramNumber
                <> help "delay before running startup scan"
                ))

diff --git a/Command/Expire.hs b/Command/Expire.hs
index 64cc882f8e9fb292e61a6d20756417e57a05a9db..99dc42939d26a5e8308ac05c96174ec7c1a984f5 100644 (file)
--- a/Command/Expire.hs
+++ b/Command/Expire.hs
@@ -103,8 +103,8 @@ parseExpire ps = do
                        return (Just r, parsetime now t)
        parsetime _ "never" = Nothing
        parsetime now s = case parseDuration s of
-               Nothing -> giveup $ "bad expire time: " ++ s
-               Just d -> Just (now - durationToPOSIXTime d)
+               Right d -> Just (now - durationToPOSIXTime d)
+               Left e -> giveup $ "bad expire time: " ++ e
 
 parseActivity :: MonadFail m => String -> m Activity
 parseActivity s = case readish s of

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 7cca7769f5866da73cf49f0c22a4a54db255c072..9553b82fe56827744f47d8aa7e909652647b1b0d 100644 (file)
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -81,7 +81,7 @@ optParser desc = FsckOptions
                        ( long "more" <> short 'm'
                        <> help "continue an incremental fsck"
                        )
-               <|> (ScheduleIncrementalO <$> option (str >>= parseDuration)
+               <|> (ScheduleIncrementalO <$> option (eitherReader parseDuration)
                        ( long "incremental-schedule" <> metavar paramTime
                        <> help "schedule incremental fscking"
                        ))

diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 7f061321cf2c6e02dfa3f6fbf6e6d01eb685c401..d1dad78c1cb78ad199cc9d7e4f7cfb2550c7a346 100644 (file)
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -177,7 +177,7 @@ extractGitConfig configsource r = GitConfig
        , annexFsckNudge = getbool (annexConfig "fscknudge") True
        , annexAutoUpgrade = toAutoUpgrade $
                getmaybe (annexConfig "autoupgrade")
-       , annexExpireUnused = maybe Nothing Just . parseDuration
+       , annexExpireUnused = either (const Nothing) Just . parseDuration
                <$> getmaybe (annexConfig "expireunused")
        , annexSecureEraseCommand = getmaybe (annexConfig "secure-erase-command")
        , annexGenMetaData = getbool (annexConfig "genmetadata") False

diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs
index ce5eb4f44e0e979224ad7bb06c45b3f2757bd5f3..87d2b88cbd2e67259b191dc0cc5eff67ef4c6500 100644 (file)
--- a/Types/ScheduledActivity.hs
+++ b/Types/ScheduledActivity.hs
@@ -46,16 +46,15 @@ parseScheduledActivity :: String -> Either String ScheduledActivity
 parseScheduledActivity s = case words s of
        ("fsck":"self":d:rest) -> qualified $ ScheduledSelfFsck
                <$> parseSchedule (unwords rest)
-               <*> getduration d
+               <*> parseDuration d
        ("fsck":u:d:rest) -> qualified $ ScheduledRemoteFsck
                <$> pure (toUUID u)
                <*> parseSchedule (unwords rest)
-               <*> getduration d
+               <*> parseDuration d
        _ -> qualified $ Left "unknown activity"
   where
        qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\""
        qualified v = v
-       getduration d = maybe (Left $ "failed to parse duration \""++d++"\"") Right (parseDuration d)
 
 fromScheduledActivities :: [ScheduledActivity] -> String
 fromScheduledActivities = intercalate "; " . map fromScheduledActivity

diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index d90143ec0932554e4a731abfcddc9e799858fc72..7db100801585de10591239d65d982f8e6bfa80bd 100644 (file)
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -19,7 +19,6 @@ module Utility.HumanTime (
 import Utility.PartialPrelude
 import Utility.QuickCheck
 
-import Control.Monad.Fail as Fail (MonadFail(..))
 import qualified Data.Map as M
 import Data.Time.Clock
 import Data.Time.Clock.POSIX (POSIXTime)
@@ -45,8 +44,8 @@ daysToDuration :: Integer -> Duration
 daysToDuration i = Duration $ i * dsecs
 
 {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
-parseDuration :: MonadFail m => String -> m Duration
-parseDuration = maybe parsefail (return . Duration) . go 0
+parseDuration :: String -> Either String Duration
+parseDuration d = maybe parsefail (Right . Duration) $ go 0 d
   where
        go n [] = return n
        go n s = do
@@ -56,7 +55,7 @@ parseDuration = maybe parsefail (return . Duration) . go 0
                                u <- M.lookup c unitmap
                                go (n + num * u) rest
                        _ -> return $ n + num
-       parsefail = Fail.fail "duration parse error; expected eg \"5m\" or \"1h5m\""
+       parsefail = Left $ "failed to parse duration \"" ++ d ++ "\" (expected eg \"5m\" or \"1h5m\")"
 
 fromDuration :: Duration -> String
 fromDuration Duration { durationSeconds = d }
@@ -102,4 +101,4 @@ instance Arbitrary Duration where
        arbitrary = Duration <$> nonNegative arbitrary
 
 prop_duration_roundtrips :: Duration -> Bool
-prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d
+prop_duration_roundtrips d = parseDuration (fromDuration d) == Right d