Typo: recurrance -> recurrence

This commit is contained in:
Yaroslav Halchenko 2023-03-13 22:35:54 -04:00 committed by Joey Hess
parent 0ae5ff797f
commit 100f5aabb6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 31 additions and 31 deletions

View file

@ -67,14 +67,14 @@ runFsckForm new activity = case activity of
(reposRes, reposView) <- mreq (selectFieldList repolist) (bfs "") (Just ru) (reposRes, reposView) <- mreq (selectFieldList repolist) (bfs "") (Just ru)
(durationRes, durationView) <- mreq intField (bfs "") (Just $ durationSeconds d `quot` 60 ) (durationRes, durationView) <- mreq intField (bfs "") (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) (bfs "") (Just t) (timeRes, timeView) <- mreq (selectFieldList times) (bfs "") (Just t)
(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) (bfs "") (Just r) (recurrenceRes, recurrenceView) <- mreq (selectFieldList recurrences) (bfs "") (Just r)
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken
$(widgetFile "configurators/fsck/formcontent") $(widgetFile "configurators/fsck/formcontent")
let formresult = mkFsck let formresult = mkFsck
<$> pure u <$> pure u
<*> reposRes <*> reposRes
<*> (Schedule <$> recurranceRes <*> timeRes) <*> (Schedule <$> recurrenceRes <*> timeRes)
<*> (Duration <$> ((60 *) <$> durationRes)) <*> (Duration <$> ((60 *) <$> durationRes))
return (formresult, form) return (formresult, form)
where where
@ -82,8 +82,8 @@ runFsckForm new activity = case activity of
times = ensurevalue t (T.pack $ fromScheduledTime t) $ times = ensurevalue t (T.pack $ fromScheduledTime t) $
map (\x -> (T.pack $ fromScheduledTime x, x)) $ map (\x -> (T.pack $ fromScheduledTime x, x)) $
AnyTime : map (\h -> SpecificTime h 0) [0..23] AnyTime : map (\h -> SpecificTime h 0) [0..23]
recurrances :: [(Text, Recurrance)] recurrences :: [(Text, Recurrence)]
recurrances = ensurevalue r (T.pack $ fromRecurrance r) $ recurrences = ensurevalue r (T.pack $ fromRecurrence r) $
[ ("every day", Daily) [ ("every day", Daily)
, ("every Sunday", Weekly $ Just 1) , ("every Sunday", Weekly $ Just 1)
, ("every Monday", Weekly $ Just 2) , ("every Monday", Weekly $ Just 2)

View file

@ -7,7 +7,7 @@
module Utility.Scheduled ( module Utility.Scheduled (
Schedule(..), Schedule(..),
Recurrance(..), Recurrence(..),
ScheduledTime(..), ScheduledTime(..),
NextTime(..), NextTime(..),
WeekDay, WeekDay,
@ -19,8 +19,8 @@ module Utility.Scheduled (
fromSchedule, fromSchedule,
fromScheduledTime, fromScheduledTime,
toScheduledTime, toScheduledTime,
fromRecurrance, fromRecurrence,
toRecurrance, toRecurrence,
toSchedule, toSchedule,
parseSchedule, parseSchedule,
prop_past_sane, prop_past_sane,
@ -44,15 +44,15 @@ import Control.Applicative
import Prelude import Prelude
{- Some sort of scheduled event. -} {- Some sort of scheduled event. -}
data Schedule = Schedule Recurrance ScheduledTime data Schedule = Schedule Recurrence ScheduledTime
deriving (Eq, Read, Show, Ord) deriving (Eq, Read, Show, Ord)
data Recurrance data Recurrence
= Daily = Daily
| Weekly (Maybe WeekDay) | Weekly (Maybe WeekDay)
| Monthly (Maybe MonthDay) | Monthly (Maybe MonthDay)
| Yearly (Maybe YearDay) | Yearly (Maybe YearDay)
| Divisible Int Recurrance | Divisible Int Recurrence
-- ^ Days, Weeks, or Months of the year evenly divisible by a number. -- ^ Days, Weeks, or Months of the year evenly divisible by a number.
-- (Divisible Year is years evenly divisible by a number.) -- (Divisible Year is years evenly divisible by a number.)
deriving (Eq, Read, Show, Ord) deriving (Eq, Read, Show, Ord)
@ -89,7 +89,7 @@ nextTime schedule lasttime = do
-- | Calculate the next time that fits a Schedule, based on the -- | Calculate the next time that fits a Schedule, based on the
-- last time it occurred, and the current time. -- last time it occurred, and the current time.
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime calcNextTime schedule@(Schedule recurrence scheduledtime) lasttime currenttime
| scheduledtime == AnyTime = do | scheduledtime == AnyTime = do
next <- findfromtoday True next <- findfromtoday True
return $ case next of return $ case next of
@ -97,7 +97,7 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
NextTimeExactly t -> window (localDay t) (localDay t) NextTimeExactly t -> window (localDay t) (localDay t)
| otherwise = NextTimeExactly . startTime <$> findfromtoday False | otherwise = NextTimeExactly . startTime <$> findfromtoday False
where where
findfromtoday anytime = findfrom recurrance afterday today findfromtoday anytime = findfrom recurrence afterday today
where where
today = localDay currenttime today = localDay currenttime
afterday = sameaslastrun || toolatetoday afterday = sameaslastrun || toolatetoday
@ -225,24 +225,24 @@ maxmnum = 12
maxwday :: Int maxwday :: Int
maxwday = 7 maxwday = 7
fromRecurrance :: Recurrance -> String fromRecurrence :: Recurrence -> String
fromRecurrance (Divisible n r) = fromRecurrence (Divisible n r) =
fromRecurrance' (++ "s divisible by " ++ show n) r fromRecurrence' (++ "s divisible by " ++ show n) r
fromRecurrance r = fromRecurrance' ("every " ++) r fromRecurrence r = fromRecurrence' ("every " ++) r
fromRecurrance' :: (String -> String) -> Recurrance -> String fromRecurrence' :: (String -> String) -> Recurrence -> String
fromRecurrance' a Daily = a "day" fromRecurrence' a Daily = a "day"
fromRecurrance' a (Weekly n) = onday n (a "week") fromRecurrence' a (Weekly n) = onday n (a "week")
fromRecurrance' a (Monthly n) = onday n (a "month") fromRecurrence' a (Monthly n) = onday n (a "month")
fromRecurrance' a (Yearly n) = onday n (a "year") fromRecurrence' a (Yearly n) = onday n (a "year")
fromRecurrance' a (Divisible _n r) = fromRecurrance' a r -- not used fromRecurrence' a (Divisible _n r) = fromRecurrence' a r -- not used
onday :: Maybe Int -> String -> String onday :: Maybe Int -> String -> String
onday (Just n) s = "on day " ++ show n ++ " of " ++ s onday (Just n) s = "on day " ++ show n ++ " of " ++ s
onday Nothing s = s onday Nothing s = s
toRecurrance :: String -> Maybe Recurrance toRecurrence :: String -> Maybe Recurrence
toRecurrance s = case words s of toRecurrence s = case words s of
("every":"day":[]) -> Just Daily ("every":"day":[]) -> Just Daily
("on":"day":sd:"of":"every":something:[]) -> withday sd something ("on":"day":sd:"of":"every":something:[]) -> withday sd something
("every":something:[]) -> noday something ("every":something:[]) -> noday something
@ -316,8 +316,8 @@ toScheduledTime v = case words v of
<*> if null m then Just 0 else readish m <*> if null m then Just 0 else readish m
fromSchedule :: Schedule -> String fromSchedule :: Schedule -> String
fromSchedule (Schedule recurrance scheduledtime) = unwords fromSchedule (Schedule recurrence scheduledtime) = unwords
[ fromRecurrance recurrance [ fromRecurrence recurrence
, "at" , "at"
, fromScheduledTime scheduledtime , fromScheduledTime scheduledtime
] ]
@ -327,14 +327,14 @@ toSchedule = eitherToMaybe . parseSchedule
parseSchedule :: String -> Either String Schedule parseSchedule :: String -> Either String Schedule
parseSchedule s = do parseSchedule s = do
r <- maybe (Left $ "bad recurrance: " ++ recurrance) Right r <- maybe (Left $ "bad recurrence: " ++ recurrence) Right
(toRecurrance recurrance) (toRecurrence recurrence)
t <- maybe (Left $ "bad time of day: " ++ scheduledtime) Right t <- maybe (Left $ "bad time of day: " ++ scheduledtime) Right
(toScheduledTime scheduledtime) (toScheduledTime scheduledtime)
Right $ Schedule r t Right $ Schedule r t
where where
(rws, tws) = separate (== "at") (words s) (rws, tws) = separate (== "at") (words s)
recurrance = unwords rws recurrence = unwords rws
scheduledtime = unwords tws scheduledtime = unwords tws
prop_past_sane :: Bool prop_past_sane :: Bool

View file

@ -26,7 +26,7 @@ instance Arbitrary ScheduledTime where
<*> choose (1, 59) <*> choose (1, 59)
] ]
instance Arbitrary Recurrance where instance Arbitrary Recurrence where
arbitrary = oneof arbitrary = oneof
[ pure Daily [ pure Daily
, Weekly <$> arbday , Weekly <$> arbday

View file

@ -7,7 +7,7 @@
^{fvInput durationView} minutes # ^{fvInput durationView} minutes #
<div .form-group> <div .form-group>
\ \
^{fvInput recurranceView} # ^{fvInput recurrenceView} #
\ \
starting at ^{fvInput timeView} # starting at ^{fvInput timeView} #
$if new $if new