From 4c58433c48b4780762b9ef5686c8ed248f9af145 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 15 Aug 2020 15:53:35 -0400 Subject: [PATCH] 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. --- CmdLine/GitAnnex/Options.hs | 4 ++-- Command/Assistant.hs | 2 +- Command/Expire.hs | 4 ++-- Command/Fsck.hs | 2 +- Types/GitConfig.hs | 2 +- Types/ScheduledActivity.hs | 5 ++--- Utility/HumanTime.hs | 9 ++++----- 7 files changed, 13 insertions(+), 15 deletions(-) diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 62f6672ed1..10cb613a36 100644 --- 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 9377357f2b..9c82d48e5f 100644 --- 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 64cc882f8e..99dc42939d 100644 --- 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 7cca7769f5..9553b82fe5 100644 --- 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 7f061321cf..d1dad78c1c 100644 --- 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 ce5eb4f44e..87d2b88cbd 100644 --- 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 d90143ec09..7db1008015 100644 --- 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 -- 2.30.2