module Utility.Scheduled (
Schedule(..),
Recurrance(..),
ScheduledTime(..),
NextTime(..),
WeekDay,
MonthDay,
YearDay,
nextTime,
calcNextTime,
startTime,
fromSchedule,
fromScheduledTime,
toScheduledTime,
fromRecurrance,
toRecurrance,
toSchedule,
parseSchedule,
prop_past_sane,
) where
import Utility.Data
import Utility.PartialPrelude
import Utility.Misc
import Utility.Tuple
import Utility.Split
import Data.List
import Data.Time.Clock
import Data.Time.LocalTime
import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate
import Data.Time.Format ()
import Data.Char
import Control.Applicative
import Prelude
data Schedule = Schedule Recurrance ScheduledTime
deriving (Schedule -> Schedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c== :: Schedule -> Schedule -> Bool
Eq, ReadPrec [Schedule]
ReadPrec Schedule
Int -> ReadS Schedule
ReadS [Schedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Schedule]
$creadListPrec :: ReadPrec [Schedule]
readPrec :: ReadPrec Schedule
$creadPrec :: ReadPrec Schedule
readList :: ReadS [Schedule]
$creadList :: ReadS [Schedule]
readsPrec :: Int -> ReadS Schedule
$creadsPrec :: Int -> ReadS Schedule
Read, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> [Char]
$cshow :: Schedule -> [Char]
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Show, Eq Schedule
Schedule -> Schedule -> Bool
Schedule -> Schedule -> Ordering
Schedule -> Schedule -> Schedule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Schedule -> Schedule -> Schedule
$cmin :: Schedule -> Schedule -> Schedule
max :: Schedule -> Schedule -> Schedule
$cmax :: Schedule -> Schedule -> Schedule
>= :: Schedule -> Schedule -> Bool
$c>= :: Schedule -> Schedule -> Bool
> :: Schedule -> Schedule -> Bool
$c> :: Schedule -> Schedule -> Bool
<= :: Schedule -> Schedule -> Bool
$c<= :: Schedule -> Schedule -> Bool
< :: Schedule -> Schedule -> Bool
$c< :: Schedule -> Schedule -> Bool
compare :: Schedule -> Schedule -> Ordering
$ccompare :: Schedule -> Schedule -> Ordering
Ord)
data Recurrance
= Daily
| Weekly (Maybe WeekDay)
| Monthly (Maybe MonthDay)
| Yearly (Maybe YearDay)
| Divisible Int Recurrance
deriving (Recurrance -> Recurrance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recurrance -> Recurrance -> Bool
$c/= :: Recurrance -> Recurrance -> Bool
== :: Recurrance -> Recurrance -> Bool
$c== :: Recurrance -> Recurrance -> Bool
Eq, ReadPrec [Recurrance]
ReadPrec Recurrance
Int -> ReadS Recurrance
ReadS [Recurrance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Recurrance]
$creadListPrec :: ReadPrec [Recurrance]
readPrec :: ReadPrec Recurrance
$creadPrec :: ReadPrec Recurrance
readList :: ReadS [Recurrance]
$creadList :: ReadS [Recurrance]
readsPrec :: Int -> ReadS Recurrance
$creadsPrec :: Int -> ReadS Recurrance
Read, Int -> Recurrance -> ShowS
[Recurrance] -> ShowS
Recurrance -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Recurrance] -> ShowS
$cshowList :: [Recurrance] -> ShowS
show :: Recurrance -> [Char]
$cshow :: Recurrance -> [Char]
showsPrec :: Int -> Recurrance -> ShowS
$cshowsPrec :: Int -> Recurrance -> ShowS
Show, Eq Recurrance
Recurrance -> Recurrance -> Bool
Recurrance -> Recurrance -> Ordering
Recurrance -> Recurrance -> Recurrance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Recurrance -> Recurrance -> Recurrance
$cmin :: Recurrance -> Recurrance -> Recurrance
max :: Recurrance -> Recurrance -> Recurrance
$cmax :: Recurrance -> Recurrance -> Recurrance
>= :: Recurrance -> Recurrance -> Bool
$c>= :: Recurrance -> Recurrance -> Bool
> :: Recurrance -> Recurrance -> Bool
$c> :: Recurrance -> Recurrance -> Bool
<= :: Recurrance -> Recurrance -> Bool
$c<= :: Recurrance -> Recurrance -> Bool
< :: Recurrance -> Recurrance -> Bool
$c< :: Recurrance -> Recurrance -> Bool
compare :: Recurrance -> Recurrance -> Ordering
$ccompare :: Recurrance -> Recurrance -> Ordering
Ord)
type WeekDay = Int
type MonthDay = Int
type YearDay = Int
data ScheduledTime
= AnyTime
| SpecificTime Hour Minute
deriving (ScheduledTime -> ScheduledTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScheduledTime -> ScheduledTime -> Bool
$c/= :: ScheduledTime -> ScheduledTime -> Bool
== :: ScheduledTime -> ScheduledTime -> Bool
$c== :: ScheduledTime -> ScheduledTime -> Bool
Eq, ReadPrec [ScheduledTime]
ReadPrec ScheduledTime
Int -> ReadS ScheduledTime
ReadS [ScheduledTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScheduledTime]
$creadListPrec :: ReadPrec [ScheduledTime]
readPrec :: ReadPrec ScheduledTime
$creadPrec :: ReadPrec ScheduledTime
readList :: ReadS [ScheduledTime]
$creadList :: ReadS [ScheduledTime]
readsPrec :: Int -> ReadS ScheduledTime
$creadsPrec :: Int -> ReadS ScheduledTime
Read, Int -> ScheduledTime -> ShowS
[ScheduledTime] -> ShowS
ScheduledTime -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ScheduledTime] -> ShowS
$cshowList :: [ScheduledTime] -> ShowS
show :: ScheduledTime -> [Char]
$cshow :: ScheduledTime -> [Char]
showsPrec :: Int -> ScheduledTime -> ShowS
$cshowsPrec :: Int -> ScheduledTime -> ShowS
Show, Eq ScheduledTime
ScheduledTime -> ScheduledTime -> Bool
ScheduledTime -> ScheduledTime -> Ordering
ScheduledTime -> ScheduledTime -> ScheduledTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScheduledTime -> ScheduledTime -> ScheduledTime
$cmin :: ScheduledTime -> ScheduledTime -> ScheduledTime
max :: ScheduledTime -> ScheduledTime -> ScheduledTime
$cmax :: ScheduledTime -> ScheduledTime -> ScheduledTime
>= :: ScheduledTime -> ScheduledTime -> Bool
$c>= :: ScheduledTime -> ScheduledTime -> Bool
> :: ScheduledTime -> ScheduledTime -> Bool
$c> :: ScheduledTime -> ScheduledTime -> Bool
<= :: ScheduledTime -> ScheduledTime -> Bool
$c<= :: ScheduledTime -> ScheduledTime -> Bool
< :: ScheduledTime -> ScheduledTime -> Bool
$c< :: ScheduledTime -> ScheduledTime -> Bool
compare :: ScheduledTime -> ScheduledTime -> Ordering
$ccompare :: ScheduledTime -> ScheduledTime -> Ordering
Ord)
type Hour = Int
type Minute = Int
data NextTime
= NextTimeExactly LocalTime
| NextTimeWindow LocalTime LocalTime
deriving (NextTime -> NextTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextTime -> NextTime -> Bool
$c/= :: NextTime -> NextTime -> Bool
== :: NextTime -> NextTime -> Bool
$c== :: NextTime -> NextTime -> Bool
Eq, ReadPrec [NextTime]
ReadPrec NextTime
Int -> ReadS NextTime
ReadS [NextTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NextTime]
$creadListPrec :: ReadPrec [NextTime]
readPrec :: ReadPrec NextTime
$creadPrec :: ReadPrec NextTime
readList :: ReadS [NextTime]
$creadList :: ReadS [NextTime]
readsPrec :: Int -> ReadS NextTime
$creadsPrec :: Int -> ReadS NextTime
Read, Int -> NextTime -> ShowS
[NextTime] -> ShowS
NextTime -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NextTime] -> ShowS
$cshowList :: [NextTime] -> ShowS
show :: NextTime -> [Char]
$cshow :: NextTime -> [Char]
showsPrec :: Int -> NextTime -> ShowS
$cshowsPrec :: Int -> NextTime -> ShowS
Show)
startTime :: NextTime -> LocalTime
startTime :: NextTime -> LocalTime
startTime (NextTimeExactly LocalTime
t) = LocalTime
t
startTime (NextTimeWindow LocalTime
t LocalTime
_) = LocalTime
t
nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
nextTime Schedule
schedule Maybe LocalTime
lasttime = do
UTCTime
now <- IO UTCTime
getCurrentTime
TimeZone
tz <- UTCTime -> IO TimeZone
getTimeZone UTCTime
now
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime Schedule
schedule Maybe LocalTime
lasttime forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
now
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime schedule :: Schedule
schedule@(Schedule Recurrance
recurrance ScheduledTime
scheduledtime) Maybe LocalTime
lasttime LocalTime
currenttime
| ScheduledTime
scheduledtime forall a. Eq a => a -> a -> Bool
== ScheduledTime
AnyTime = do
NextTime
next <- Bool -> Maybe NextTime
findfromtoday Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case NextTime
next of
NextTimeWindow LocalTime
_ LocalTime
_ -> NextTime
next
NextTimeExactly LocalTime
t -> Day -> Day -> NextTime
window (LocalTime -> Day
localDay LocalTime
t) (LocalTime -> Day
localDay LocalTime
t)
| Bool
otherwise = LocalTime -> NextTime
NextTimeExactly forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe NextTime
findfromtoday Bool
False
where
findfromtoday :: Bool -> Maybe NextTime
findfromtoday Bool
anytime = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
recurrance Bool
afterday Day
today
where
today :: Day
today = LocalTime -> Day
localDay LocalTime
currenttime
afterday :: Bool
afterday = Bool
sameaslastrun Bool -> Bool -> Bool
|| Bool
toolatetoday
toolatetoday :: Bool
toolatetoday = Bool -> Bool
not Bool
anytime Bool -> Bool -> Bool
&& LocalTime -> TimeOfDay
localTimeOfDay LocalTime
currenttime forall a. Ord a => a -> a -> Bool
>= TimeOfDay
nexttime
sameaslastrun :: Bool
sameaslastrun = Maybe Day
lastrun forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Day
today
lastrun :: Maybe Day
lastrun = LocalTime -> Day
localDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalTime
lasttime
nexttime :: TimeOfDay
nexttime = case ScheduledTime
scheduledtime of
ScheduledTime
AnyTime -> Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0
SpecificTime Int
h Int
m -> Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
0
exactly :: Day -> NextTime
exactly Day
d = LocalTime -> NextTime
NextTimeExactly forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
nexttime
window :: Day -> Day -> NextTime
window Day
startd Day
endd = LocalTime -> LocalTime -> NextTime
NextTimeWindow
(Day -> TimeOfDay -> LocalTime
LocalTime Day
startd TimeOfDay
nexttime)
(Day -> TimeOfDay -> LocalTime
LocalTime Day
endd (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 Pico
0))
findfrom :: Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
afterday Day
candidate
| Day -> Int
ynum Day
candidate forall a. Ord a => a -> a -> Bool
> (Day -> Int
ynum (LocalTime -> Day
localDay LocalTime
currenttime)) forall a. Num a => a -> a -> a
+ Int
100 =
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"bug: calcNextTime did not find a time within 100 years to run " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show (Schedule
schedule, Maybe LocalTime
lasttime, LocalTime
currenttime)
| Bool
otherwise = Recurrance -> Bool -> Day -> Maybe NextTime
findfromChecked Recurrance
r Bool
afterday Day
candidate
findfromChecked :: Recurrance -> Bool -> Day -> Maybe NextTime
findfromChecked Recurrance
r Bool
afterday Day
candidate = case Recurrance
r of
Recurrance
Daily
| Bool
afterday -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
1 Day
candidate
| Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
Weekly Maybe Int
Nothing
| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
| Bool
otherwise -> case (Day -> Int
wday forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
lastrun, Day -> Int
wday Day
candidate) of
(Maybe Int
Nothing, Int
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Year -> Day -> Day
addDays Year
6 Day
candidate)
(Just Int
old, Int
curr)
| Int
old forall a. Eq a => a -> a -> Bool
== Int
curr -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Year -> Day -> Day
addDays Year
6 Day
candidate)
| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
Monthly Maybe Int
Nothing
| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneMonthPast`) Maybe Day
lastrun ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfMonth Day
candidate)
| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
Yearly Maybe Int
Nothing
| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneYearPast`) Maybe Day
lastrun ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfYear Day
candidate)
| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
Weekly (Just Int
w)
| Int
w forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
w forall a. Ord a => a -> a -> Bool
> Int
maxwday -> forall a. Maybe a
Nothing
| Int
w forall a. Eq a => a -> a -> Bool
== Day -> Int
wday Day
candidate -> if Bool
afterday
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
7 Day
candidate
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$
Year -> Day -> Day
addDays (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
w forall a. Num a => a -> a -> a
- Day -> Int
wday Day
candidate) forall a. Integral a => a -> a -> a
`mod` Int
7) Day
candidate
Monthly (Just Int
m)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
maxmday -> forall a. Maybe a
Nothing
| Int
m forall a. Eq a => a -> a -> Bool
== Day -> Int
mday Day
candidate -> if Bool
afterday
then Year -> Maybe NextTime
skip Year
1
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
Yearly (Just Int
y)
| Int
y forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y forall a. Ord a => a -> a -> Bool
> Int
maxyday -> forall a. Maybe a
Nothing
| Int
y forall a. Eq a => a -> a -> Bool
== Day -> Int
yday Day
candidate -> if Bool
afterday
then Year -> Maybe NextTime
skip Year
365
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
Divisible Int
n r' :: Recurrance
r'@Recurrance
Daily -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
yday (forall a. a -> Maybe a
Just Int
maxyday)
Divisible Int
n r' :: Recurrance
r'@(Weekly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
wnum (forall a. a -> Maybe a
Just Int
maxwnum)
Divisible Int
n r' :: Recurrance
r'@(Monthly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
mnum (forall a. a -> Maybe a
Just Int
maxmnum)
Divisible Int
n r' :: Recurrance
r'@(Yearly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
ynum forall a. Maybe a
Nothing
Divisible Int
_ r' :: Recurrance
r'@(Divisible Int
_ Recurrance
_) -> Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r' Bool
afterday Day
candidate
where
skip :: Year -> Maybe NextTime
skip Year
n = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
False (Year -> Day -> Day
addDays Year
n Day
candidate)
handlediv :: b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv b
n Recurrance
r' Day -> b
getval Maybe b
mmax
| b
n forall a. Ord a => a -> a -> Bool
> b
0 Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (b
n forall a. Ord a => a -> a -> Bool
<=) Maybe b
mmax =
Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r' (forall {a}. Integral a => a -> a -> Bool
divisible b
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> b
getval) Bool
afterday Day
candidate
| Bool
otherwise = forall a. Maybe a
Nothing
findfromwhere :: Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
afterday Day
candidate
| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> Day
getday) Maybe NextTime
next = Maybe NextTime
next
| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> Day
getday) Maybe NextTime
next
where
next :: Maybe NextTime
next = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
afterday Day
candidate
getday :: NextTime -> Day
getday = LocalTime -> Day
localDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime
divisible :: a -> a -> Bool
divisible a
n a
v = a
v forall a. Integral a => a -> a -> a
`rem` a
n forall a. Eq a => a -> a -> Bool
== a
0
oneMonthPast :: Day -> Day -> Bool
Day
new oneMonthPast :: Day -> Day -> Bool
`oneMonthPast` Day
old = Year -> Int -> Int -> Day
fromGregorian Year
y (Int
mforall a. Num a => a -> a -> a
+Int
1) Int
d forall a. Ord a => a -> a -> Bool
<= Day
new
where
(Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
old
oneYearPast :: Day -> Day -> Bool
Day
new oneYearPast :: Day -> Day -> Bool
`oneYearPast` Day
old = Year -> Int -> Int -> Day
fromGregorian (Year
yforall a. Num a => a -> a -> a
+Year
1) Int
m Int
d forall a. Ord a => a -> a -> Bool
<= Day
new
where
(Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
old
endOfMonth :: Day -> Day
endOfMonth :: Day -> Day
endOfMonth Day
day =
let (Year
y,Int
m,Int
_d) = Day -> (Year, Int, Int)
toGregorian Day
day
in Year -> Int -> Int -> Day
fromGregorian Year
y Int
m (Year -> Int -> Int
gregorianMonthLength Year
y Int
m)
endOfYear :: Day -> Day
endOfYear :: Day -> Day
endOfYear Day
day =
let (Year
y,Int
_m,Int
_d) = Day -> (Year, Int, Int)
toGregorian Day
day
in Day -> Day
endOfMonth (Year -> Int -> Int -> Day
fromGregorian Year
y Int
maxmnum Int
1)
wday :: Day -> Int
wday :: Day -> Int
wday = forall a b c. (a, b, c) -> c
thd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
wnum :: Day -> Int
wnum :: Day -> Int
wnum = forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
mday :: Day -> Int
mday :: Day -> Int
mday = forall a b c. (a, b, c) -> c
thd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
mnum :: Day -> Int
mnum :: Day -> Int
mnum = forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
yday :: Day -> Int
yday :: Day -> Int
yday = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int)
toOrdinalDate
ynum :: Day -> Int
ynum :: Day -> Int
ynum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int)
toOrdinalDate
maxyday :: Int
maxyday :: Int
maxyday = Int
366
maxwnum :: Int
maxwnum :: Int
maxwnum = Int
53
maxmday :: Int
maxmday :: Int
maxmday = Int
31
maxmnum :: Int
maxmnum :: Int
maxmnum = Int
12
maxwday :: Int
maxwday :: Int
maxwday = Int
7
fromRecurrance :: Recurrance -> String
fromRecurrance :: Recurrance -> [Char]
fromRecurrance (Divisible Int
n Recurrance
r) =
ShowS -> Recurrance -> [Char]
fromRecurrance' (forall a. [a] -> [a] -> [a]
++ [Char]
"s divisible by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n) Recurrance
r
fromRecurrance Recurrance
r = ShowS -> Recurrance -> [Char]
fromRecurrance' ([Char]
"every " forall a. [a] -> [a] -> [a]
++) Recurrance
r
fromRecurrance' :: (String -> String) -> Recurrance -> String
fromRecurrance' :: ShowS -> Recurrance -> [Char]
fromRecurrance' ShowS
a Recurrance
Daily = ShowS
a [Char]
"day"
fromRecurrance' ShowS
a (Weekly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"week")
fromRecurrance' ShowS
a (Monthly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"month")
fromRecurrance' ShowS
a (Yearly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"year")
fromRecurrance' ShowS
a (Divisible Int
_n Recurrance
r) = ShowS -> Recurrance -> [Char]
fromRecurrance' ShowS
a Recurrance
r
onday :: Maybe Int -> String -> String
onday :: Maybe Int -> ShowS
onday (Just Int
n) [Char]
s = [Char]
"on day " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
" of " forall a. [a] -> [a] -> [a]
++ [Char]
s
onday Maybe Int
Nothing [Char]
s = [Char]
s
toRecurrance :: String -> Maybe Recurrance
toRecurrance :: [Char] -> Maybe Recurrance
toRecurrance [Char]
s = case [Char] -> [[Char]]
words [Char]
s of
([Char]
"every":[Char]
"day":[]) -> forall a. a -> Maybe a
Just Recurrance
Daily
([Char]
"on":[Char]
"day":[Char]
sd:[Char]
"of":[Char]
"every":[Char]
something:[]) -> [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
something
([Char]
"every":[Char]
something:[]) -> [Char] -> Maybe Recurrance
noday [Char]
something
([Char]
"days":[Char]
"divisible":[Char]
"by":[Char]
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Recurrance
Daily
([Char]
"on":[Char]
"day":[Char]
sd:[Char]
"of":[Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
something
([Char]
"every":[Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Recurrance
noday [Char]
something
([Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Recurrance
noday [Char]
something
[[Char]]
_ -> forall a. Maybe a
Nothing
where
constructor :: [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
"week" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Weekly
constructor [Char]
"month" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Monthly
constructor [Char]
"year" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Yearly
constructor [Char]
u
| [Char]
"s" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
u = [Char] -> Maybe (Maybe Int -> Recurrance)
constructor forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
dropFromEnd Int
1 [Char]
u
| Bool
otherwise = forall a. Maybe a
Nothing
withday :: [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
u = do
Maybe Int -> Recurrance
c <- [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
u
Int
d <- forall a. Read a => [Char] -> Maybe a
readish [Char]
sd
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c (forall a. a -> Maybe a
Just Int
d)
noday :: [Char] -> Maybe Recurrance
noday [Char]
u = do
Maybe Int -> Recurrance
c <- [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
u
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c forall a. Maybe a
Nothing
getdivisor :: [Char] -> Maybe b
getdivisor [Char]
sn = do
b
n <- forall a. Read a => [Char] -> Maybe a
readish [Char]
sn
if b
n forall a. Ord a => a -> a -> Bool
> b
0
then forall a. a -> Maybe a
Just b
n
else forall a. Maybe a
Nothing
fromScheduledTime :: ScheduledTime -> String
fromScheduledTime :: ScheduledTime -> [Char]
fromScheduledTime ScheduledTime
AnyTime = [Char]
"any time"
fromScheduledTime (SpecificTime Int
h Int
m) =
forall a. Show a => a -> [Char]
show Int
h' forall a. [a] -> [a] -> [a]
++ (if Int
m forall a. Ord a => a -> a -> Bool
> Int
0 then [Char]
":" forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (forall a. Show a => a -> [Char]
show Int
m) else [Char]
"") forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
ampm
where
pad :: Int -> ShowS
pad Int
n [Char]
s = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
s
(Int
h', [Char]
ampm)
| Int
h forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
12, [Char]
"AM")
| Int
h forall a. Ord a => a -> a -> Bool
< Int
12 = (Int
h, [Char]
"AM")
| Int
h forall a. Eq a => a -> a -> Bool
== Int
12 = (Int
h, [Char]
"PM")
| Bool
otherwise = (Int
h forall a. Num a => a -> a -> a
- Int
12, [Char]
"PM")
toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime :: [Char] -> Maybe ScheduledTime
toScheduledTime [Char]
"any time" = forall a. a -> Maybe a
Just ScheduledTime
AnyTime
toScheduledTime [Char]
v = case [Char] -> [[Char]]
words [Char]
v of
([Char]
s:[Char]
ampm:[])
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm forall a. Eq a => a -> a -> Bool
== [Char]
"AM" ->
[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s forall {a}. (Eq a, Num a) => a -> a
h0
| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm forall a. Eq a => a -> a -> Bool
== [Char]
"PM" ->
[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s (\Int
h -> (forall {a}. (Eq a, Num a) => a -> a
h0 Int
h) forall a. Num a => a -> a -> a
+ Int
12)
| Bool
otherwise -> forall a. Maybe a
Nothing
([Char]
s:[]) -> [Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s forall a. a -> a
id
[[Char]]
_ -> forall a. Maybe a
Nothing
where
h0 :: a -> a
h0 a
h
| a
h forall a. Eq a => a -> a -> Bool
== a
12 = a
0
| Bool
otherwise = a
h
go :: String -> (Int -> Int) -> Maybe ScheduledTime
go :: [Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s Int -> Int
adjust =
let ([Char]
h, [Char]
m) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
s
in Int -> Int -> ScheduledTime
SpecificTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int
adjust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
readish [Char]
h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
m then forall a. a -> Maybe a
Just Int
0 else forall a. Read a => [Char] -> Maybe a
readish [Char]
m
fromSchedule :: Schedule -> String
fromSchedule :: Schedule -> [Char]
fromSchedule (Schedule Recurrance
recurrance ScheduledTime
scheduledtime) = [[Char]] -> [Char]
unwords
[ Recurrance -> [Char]
fromRecurrance Recurrance
recurrance
, [Char]
"at"
, ScheduledTime -> [Char]
fromScheduledTime ScheduledTime
scheduledtime
]
toSchedule :: String -> Maybe Schedule
toSchedule :: [Char] -> Maybe Schedule
toSchedule = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] Schedule
parseSchedule
parseSchedule :: String -> Either String Schedule
parseSchedule :: [Char] -> Either [Char] Schedule
parseSchedule [Char]
s = do
Recurrance
r <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"bad recurrance: " forall a. [a] -> [a] -> [a]
++ [Char]
recurrance) forall a b. b -> Either a b
Right
([Char] -> Maybe Recurrance
toRecurrance [Char]
recurrance)
ScheduledTime
t <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"bad time of day: " forall a. [a] -> [a] -> [a]
++ [Char]
scheduledtime) forall a b. b -> Either a b
Right
([Char] -> Maybe ScheduledTime
toScheduledTime [Char]
scheduledtime)
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Recurrance -> ScheduledTime -> Schedule
Schedule Recurrance
r ScheduledTime
t
where
([[Char]]
rws, [[Char]]
tws) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== [Char]
"at") ([Char] -> [[Char]]
words [Char]
s)
recurrance :: [Char]
recurrance = [[Char]] -> [Char]
unwords [[Char]]
rws
scheduledtime :: [Char]
scheduledtime = [[Char]] -> [Char]
unwords [[Char]]
tws
prop_past_sane :: Bool
prop_past_sane :: Bool
prop_past_sane = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast) ([(Day, Day)]
mplus1 forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1)
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast)) (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap ([(Day, Day)]
mplus1 forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1))
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast) [(Day, Day)]
yplus1
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast)) (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap [(Day, Day)]
yplus1)
]
where
mplus1 :: [(Day, Day)]
mplus1 =
[ (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
01 Int
15, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
12 Int
15)
, (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
01 Int
15, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
02 Int
15)
, (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
02 Int
15, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
01 Int
15)
, (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
03 Int
01, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
01 Int
15)
, (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
03 Int
01, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
12 Int
15)
, (Year -> Int -> Int -> Day
fromGregorian Year
2015 Int
01 Int
01, Year -> Int -> Int -> Day
fromGregorian Year
2010 Int
01 Int
01)
]
yplus1 :: [(Day, Day)]
yplus1 =
[ (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
01 Int
15, Year -> Int -> Int -> Day
fromGregorian Year
2012 Int
01 Int
16)
, (Year -> Int -> Int -> Day
fromGregorian Year
2014 Int
01 Int
15, Year -> Int -> Int -> Day
fromGregorian Year
2013 Int
01 Int
14)
, (Year -> Int -> Int -> Day
fromGregorian Year
2022 Int
12 Int
31, Year -> Int -> Int -> Day
fromGregorian Year
2000 Int
01 Int
01)
]
checksout :: (t -> t -> t) -> (t, t) -> t
checksout t -> t -> t
cmp (t
new, t
old) = t
new t -> t -> t
`cmp` t
old
swap :: (b, a) -> (a, b)
swap (b
a,a
b) = (a
b,b
a)