diff options
| -rw-r--r-- | Types/ScheduledActivity.hs | 28 | ||||
| -rw-r--r-- | Utility/Scheduled.hs | 40 |
2 files changed, 28 insertions, 40 deletions
diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs index dc37fe173..e29050d8e 100644 --- a/Types/ScheduledActivity.hs +++ b/Types/ScheduledActivity.hs @@ -9,30 +9,42 @@ module Types.ScheduledActivity where import Common import Utility.Scheduled +import Utility.HumanTime import Types.UUID data ScheduledActivity - = ScheduledSelfFsck Schedule - | ScheduledRemoteFsck UUID Schedule + = ScheduledSelfFsck Schedule Duration + | ScheduledRemoteFsck UUID Schedule Duration deriving (Eq, Read, Show, Ord) +getSchedule :: ScheduledActivity -> Schedule +getSchedule (ScheduledSelfFsck s _) = s +getSchedule (ScheduledRemoteFsck _ s _) = s + +getDuration :: ScheduledActivity -> Duration +getDuration (ScheduledSelfFsck _ d) = d +getDuration (ScheduledRemoteFsck _ _ d) = d + fromScheduledActivity :: ScheduledActivity -> String -fromScheduledActivity (ScheduledSelfFsck s) = - "fsck self " ++ fromSchedule s -fromScheduledActivity (ScheduledRemoteFsck u s) = - "fsck " ++ fromUUID u ++ fromSchedule s +fromScheduledActivity (ScheduledSelfFsck s d) = unwords + [ "fsck self", fromDuration d, fromSchedule s ] +fromScheduledActivity (ScheduledRemoteFsck u s d) = unwords + [ "fsck", fromUUID u, fromDuration d, fromSchedule s ] toScheduledActivity :: String -> Maybe ScheduledActivity toScheduledActivity = eitherToMaybe . parseScheduledActivity parseScheduledActivity :: String -> Either String ScheduledActivity parseScheduledActivity s = case words s of - ("fsck":"self":rest) -> qualified $ ScheduledSelfFsck + ("fsck":"self":d:rest) -> qualified $ ScheduledSelfFsck <$> parseSchedule (unwords rest) - ("fsck":u:rest) -> qualified $ ScheduledRemoteFsck + <*> getduration d + ("fsck":u:d:rest) -> qualified $ ScheduledRemoteFsck <$> pure (toUUID u) <*> parseSchedule (unwords rest) + <*> getduration 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) diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index 1fc8596f5..a0b0bb964 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -9,7 +9,7 @@ module Utility.Scheduled ( Schedule(..), Recurrance(..), ScheduledTime(..), - Duration(..), + NextTime(..), nextTime, fromSchedule, toSchedule, @@ -28,7 +28,7 @@ import Data.Time.Calendar.OrdinalDate import Data.Tuple.Utils {- Some sort of scheduled event. -} -data Schedule = Schedule Recurrance ScheduledTime Duration +data Schedule = Schedule Recurrance ScheduledTime deriving (Eq, Read, Show, Ord) data Recurrance @@ -53,9 +53,6 @@ data ScheduledTime type Hour = Int type Minute = Int -data Duration = MinutesDuration Int - deriving (Eq, Read, Show, Ord) - {- Next time a Schedule should take effect. The NextTimeWindow is used - when a Schedule is allowed to start at some point within the window. -} data NextTime @@ -72,7 +69,7 @@ nextTime schedule lasttime = do {- Calculate the next time that fits a Schedule, based on the - last time it occurred, and the current time. -} calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime -calcNextTime (Schedule recurrance scheduledtime _duration) lasttime currenttime +calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime | scheduledtime == AnyTime = do start <- findfromtoday return $ NextTimeWindow @@ -196,22 +193,11 @@ toScheduledTime s = let (h, m) = separate (== ':') s in SpecificTime <$> readish h <*> readish m -fromDuration :: Duration -> String -fromDuration (MinutesDuration n) = show n ++ " minutes" - -toDuration :: String -> Maybe Duration -toDuration s = case words s of - (n:"minutes":[]) -> MinutesDuration <$> readish n - (n:"minute":[]) -> MinutesDuration <$> readish n - _ -> Nothing - fromSchedule :: Schedule -> String -fromSchedule (Schedule recurrance scheduledtime duration) = unwords +fromSchedule (Schedule recurrance scheduledtime) = unwords [ fromRecurrance recurrance , "at" , fromScheduledTime scheduledtime - , "for" - , fromDuration duration ] toSchedule :: String -> Maybe Schedule @@ -223,22 +209,14 @@ parseSchedule s = do (toRecurrance recurrance) t <- maybe (Left $ "bad time of day: " ++ scheduledtime) Right (toScheduledTime scheduledtime) - d <- maybe (Left $ "bad duration: " ++ duration) Right - (toDuration duration) - Right $ Schedule r t d + Right $ Schedule r t where - ws = words s - (rws, ws') = separate (== "at") ws - (tws, dws) = separate (== "for") ws' + (rws, tws) = separate (== "at") (words s) recurrance = unwords rws scheduledtime = unwords tws - duration = unwords dws instance Arbitrary Schedule where - arbitrary = Schedule <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary Duration where - arbitrary = MinutesDuration <$> nonNegative arbitrary + arbitrary = Schedule <$> arbitrary <*> arbitrary instance Arbitrary ScheduledTime where arbitrary = oneof @@ -265,6 +243,4 @@ instance Arbitrary Recurrance where ] prop_schedule_roundtrips :: Schedule -> Bool -prop_schedule_roundtrips s = case toSchedule $ fromSchedule s of - Just s' | s == s' -> True - _ -> False +prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s |