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
(Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool) -> Eq Schedule
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]
(Int -> ReadS Schedule)
-> ReadS [Schedule]
-> ReadPrec Schedule
-> ReadPrec [Schedule]
-> Read 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 -> String
(Int -> Schedule -> ShowS)
-> (Schedule -> String) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> String
$cshow :: Schedule -> String
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Show, Eq Schedule
Eq Schedule
-> (Schedule -> Schedule -> Ordering)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Schedule)
-> (Schedule -> Schedule -> Schedule)
-> Ord 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
$cp1Ord :: Eq Schedule
Ord)
data Recurrance
= Daily
| Weekly (Maybe WeekDay)
| Monthly (Maybe MonthDay)
| Yearly (Maybe YearDay)
| Divisible Int Recurrance
deriving (Recurrance -> Recurrance -> Bool
(Recurrance -> Recurrance -> Bool)
-> (Recurrance -> Recurrance -> Bool) -> Eq Recurrance
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]
(Int -> ReadS Recurrance)
-> ReadS [Recurrance]
-> ReadPrec Recurrance
-> ReadPrec [Recurrance]
-> Read 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 -> String
(Int -> Recurrance -> ShowS)
-> (Recurrance -> String)
-> ([Recurrance] -> ShowS)
-> Show Recurrance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recurrance] -> ShowS
$cshowList :: [Recurrance] -> ShowS
show :: Recurrance -> String
$cshow :: Recurrance -> String
showsPrec :: Int -> Recurrance -> ShowS
$cshowsPrec :: Int -> Recurrance -> ShowS
Show, Eq Recurrance
Eq Recurrance
-> (Recurrance -> Recurrance -> Ordering)
-> (Recurrance -> Recurrance -> Bool)
-> (Recurrance -> Recurrance -> Bool)
-> (Recurrance -> Recurrance -> Bool)
-> (Recurrance -> Recurrance -> Bool)
-> (Recurrance -> Recurrance -> Recurrance)
-> (Recurrance -> Recurrance -> Recurrance)
-> Ord 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
$cp1Ord :: Eq Recurrance
Ord)
type WeekDay = Int
type MonthDay = Int
type YearDay = Int
data ScheduledTime
= AnyTime
| SpecificTime Hour Minute
deriving (ScheduledTime -> ScheduledTime -> Bool
(ScheduledTime -> ScheduledTime -> Bool)
-> (ScheduledTime -> ScheduledTime -> Bool) -> Eq ScheduledTime
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]
(Int -> ReadS ScheduledTime)
-> ReadS [ScheduledTime]
-> ReadPrec ScheduledTime
-> ReadPrec [ScheduledTime]
-> Read 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 -> String
(Int -> ScheduledTime -> ShowS)
-> (ScheduledTime -> String)
-> ([ScheduledTime] -> ShowS)
-> Show ScheduledTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScheduledTime] -> ShowS
$cshowList :: [ScheduledTime] -> ShowS
show :: ScheduledTime -> String
$cshow :: ScheduledTime -> String
showsPrec :: Int -> ScheduledTime -> ShowS
$cshowsPrec :: Int -> ScheduledTime -> ShowS
Show, Eq ScheduledTime
Eq ScheduledTime
-> (ScheduledTime -> ScheduledTime -> Ordering)
-> (ScheduledTime -> ScheduledTime -> Bool)
-> (ScheduledTime -> ScheduledTime -> Bool)
-> (ScheduledTime -> ScheduledTime -> Bool)
-> (ScheduledTime -> ScheduledTime -> Bool)
-> (ScheduledTime -> ScheduledTime -> ScheduledTime)
-> (ScheduledTime -> ScheduledTime -> ScheduledTime)
-> Ord 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
$cp1Ord :: Eq ScheduledTime
Ord)
type Hour = Int
type Minute = Int
data NextTime
= NextTimeExactly LocalTime
| NextTimeWindow LocalTime LocalTime
deriving (NextTime -> NextTime -> Bool
(NextTime -> NextTime -> Bool)
-> (NextTime -> NextTime -> Bool) -> Eq NextTime
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]
(Int -> ReadS NextTime)
-> ReadS [NextTime]
-> ReadPrec NextTime
-> ReadPrec [NextTime]
-> Read 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 -> String
(Int -> NextTime -> ShowS)
-> (NextTime -> String) -> ([NextTime] -> ShowS) -> Show NextTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NextTime] -> ShowS
$cshowList :: [NextTime] -> ShowS
show :: NextTime -> String
$cshow :: NextTime -> String
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
Maybe NextTime -> IO (Maybe NextTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NextTime -> IO (Maybe NextTime))
-> Maybe NextTime -> IO (Maybe NextTime)
forall a b. (a -> b) -> a -> b
$ Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime Schedule
schedule Maybe LocalTime
lasttime (LocalTime -> Maybe NextTime) -> LocalTime -> Maybe NextTime
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 ScheduledTime -> ScheduledTime -> Bool
forall a. Eq a => a -> a -> Bool
== ScheduledTime
AnyTime = do
NextTime
next <- Bool -> Maybe NextTime
findfromtoday Bool
True
NextTime -> Maybe NextTime
forall (m :: * -> *) a. Monad m => a -> m a
return (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
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 (LocalTime -> NextTime)
-> (NextTime -> LocalTime) -> NextTime -> NextTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime (NextTime -> NextTime) -> Maybe NextTime -> Maybe NextTime
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 TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeOfDay
nexttime
sameaslastrun :: Bool
sameaslastrun = Maybe Day
lastrun Maybe Day -> Maybe Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day -> Maybe Day
forall a. a -> Maybe a
Just Day
today
lastrun :: Maybe Day
lastrun = LocalTime -> Day
localDay (LocalTime -> Day) -> Maybe LocalTime -> Maybe Day
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 (LocalTime -> NextTime) -> LocalTime -> NextTime
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Day -> Int
ynum (LocalTime -> Day
localDay LocalTime
currenttime)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
100 =
String -> Maybe NextTime
forall a. HasCallStack => String -> a
error (String -> Maybe NextTime) -> String -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ String
"bug: calcNextTime did not find a time within 100 years to run " String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Schedule, Maybe LocalTime, LocalTime) -> String
forall a. Show a => a -> String
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 -> NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly (Day -> NextTime) -> Day -> NextTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 Day
candidate
| Bool
otherwise -> NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
Weekly Maybe Int
Nothing
| Bool
afterday -> Integer -> Maybe NextTime
skip Integer
1
| Bool
otherwise -> case (Day -> Int
wday (Day -> Int) -> Maybe Day -> Maybe Int
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
_) -> NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Integer -> Day -> Day
addDays Integer
6 Day
candidate)
(Just Int
old, Int
curr)
| Int
old Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
curr -> NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Integer -> Day -> Day
addDays Integer
6 Day
candidate)
| Bool
otherwise -> Integer -> Maybe NextTime
skip Integer
1
Monthly Maybe Int
Nothing
| Bool
afterday -> Integer -> Maybe NextTime
skip Integer
1
| Bool -> (Day -> Bool) -> Maybe Day -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneMonthPast`) Maybe Day
lastrun ->
NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfMonth Day
candidate)
| Bool
otherwise -> Integer -> Maybe NextTime
skip Integer
1
Yearly Maybe Int
Nothing
| Bool
afterday -> Integer -> Maybe NextTime
skip Integer
1
| Bool -> (Day -> Bool) -> Maybe Day -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneYearPast`) Maybe Day
lastrun ->
NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfYear Day
candidate)
| Bool
otherwise -> Integer -> Maybe NextTime
skip Integer
1
Weekly (Just Int
w)
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxwday -> Maybe NextTime
forall a. Maybe a
Nothing
| Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Day -> Int
wday Day
candidate -> if Bool
afterday
then NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly (Day -> NextTime) -> Day -> NextTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
7 Day
candidate
else NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly (Day -> NextTime) -> Day -> NextTime
forall a b. (a -> b) -> a -> b
$
Integer -> Day -> Day
addDays (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Day -> Int
wday Day
candidate) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7) Day
candidate
Monthly (Just Int
m)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxmday -> Maybe NextTime
forall a. Maybe a
Nothing
| Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Day -> Int
mday Day
candidate -> if Bool
afterday
then Integer -> Maybe NextTime
skip Integer
1
else NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> Integer -> Maybe NextTime
skip Integer
1
Yearly (Just Int
y)
| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxyday -> Maybe NextTime
forall a. Maybe a
Nothing
| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Day -> Int
yday Day
candidate -> if Bool
afterday
then Integer -> Maybe NextTime
skip Integer
365
else NextTime -> Maybe NextTime
forall a. a -> Maybe a
Just (NextTime -> Maybe NextTime) -> NextTime -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
| Bool
otherwise -> Integer -> Maybe NextTime
skip Integer
1
Divisible Int
n r' :: Recurrance
r'@Recurrance
Daily -> Int -> Recurrance -> (Day -> Int) -> Maybe Int -> Maybe NextTime
forall a.
Integral a =>
a -> Recurrance -> (Day -> a) -> Maybe a -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
yday (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxyday)
Divisible Int
n r' :: Recurrance
r'@(Weekly Maybe Int
_) -> Int -> Recurrance -> (Day -> Int) -> Maybe Int -> Maybe NextTime
forall a.
Integral a =>
a -> Recurrance -> (Day -> a) -> Maybe a -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
wnum (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxwnum)
Divisible Int
n r' :: Recurrance
r'@(Monthly Maybe Int
_) -> Int -> Recurrance -> (Day -> Int) -> Maybe Int -> Maybe NextTime
forall a.
Integral a =>
a -> Recurrance -> (Day -> a) -> Maybe a -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
mnum (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxmnum)
Divisible Int
n r' :: Recurrance
r'@(Yearly Maybe Int
_) -> Int -> Recurrance -> (Day -> Int) -> Maybe Int -> Maybe NextTime
forall a.
Integral a =>
a -> Recurrance -> (Day -> a) -> Maybe a -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
ynum Maybe Int
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 :: Integer -> Maybe NextTime
skip Integer
n = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
False (Integer -> Day -> Day
addDays Integer
n Day
candidate)
handlediv :: a -> Recurrance -> (Day -> a) -> Maybe a -> Maybe NextTime
handlediv a
n Recurrance
r' Day -> a
getval Maybe a
mmax
| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) Maybe a
mmax =
Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r' (a -> a -> Bool
forall a. Integral a => a -> a -> Bool
divisible a
n (a -> Bool) -> (Day -> a) -> Day -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> a
getval) Bool
afterday Day
candidate
| Bool
otherwise = Maybe NextTime
forall a. Maybe a
Nothing
findfromwhere :: Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
afterday Day
candidate
| Bool -> (NextTime -> Bool) -> Maybe NextTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day -> Bool
p (Day -> Bool) -> (NextTime -> Day) -> NextTime -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> Day
getday) Maybe NextTime
next = Maybe NextTime
next
| Bool
otherwise = Maybe NextTime
-> (NextTime -> Maybe NextTime) -> Maybe NextTime -> Maybe NextTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe NextTime
forall a. Maybe a
Nothing (Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
True (Day -> Maybe NextTime)
-> (NextTime -> Day) -> NextTime -> Maybe NextTime
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 (LocalTime -> Day) -> (NextTime -> LocalTime) -> NextTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime
divisible :: a -> a -> Bool
divisible a
n a
v = a
v a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
oneMonthPast :: Day -> Day -> Bool
Day
new oneMonthPast :: Day -> Day -> Bool
`oneMonthPast` Day
old = Integer -> Int -> Int -> Day
fromGregorian Integer
y (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
new
where
(Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
old
oneYearPast :: Day -> Day -> Bool
Day
new oneYearPast :: Day -> Day -> Bool
`oneYearPast` Day
old = Integer -> Int -> Int -> Day
fromGregorian (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Int
m Int
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
new
where
(Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
old
endOfMonth :: Day -> Day
endOfMonth :: Day -> Day
endOfMonth Day
day =
let (Integer
y,Int
m,Int
_d) = Day -> (Integer, Int, Int)
toGregorian Day
day
in Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m (Integer -> Int -> Int
gregorianMonthLength Integer
y Int
m)
endOfYear :: Day -> Day
endOfYear :: Day -> Day
endOfYear Day
day =
let (Integer
y,Int
_m,Int
_d) = Day -> (Integer, Int, Int)
toGregorian Day
day
in Day -> Day
endOfMonth (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
maxmnum Int
1)
wday :: Day -> Int
wday :: Day -> Int
wday = (Integer, Int, Int) -> Int
forall a b c. (a, b, c) -> c
thd3 ((Integer, Int, Int) -> Int)
-> (Day -> (Integer, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toWeekDate
wnum :: Day -> Int
wnum :: Day -> Int
wnum = (Integer, Int, Int) -> Int
forall a b c. (a, b, c) -> b
snd3 ((Integer, Int, Int) -> Int)
-> (Day -> (Integer, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toWeekDate
mday :: Day -> Int
mday :: Day -> Int
mday = (Integer, Int, Int) -> Int
forall a b c. (a, b, c) -> c
thd3 ((Integer, Int, Int) -> Int)
-> (Day -> (Integer, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
mnum :: Day -> Int
mnum :: Day -> Int
mnum = (Integer, Int, Int) -> Int
forall a b c. (a, b, c) -> b
snd3 ((Integer, Int, Int) -> Int)
-> (Day -> (Integer, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
yday :: Day -> Int
yday :: Day -> Int
yday = (Integer, Int) -> Int
forall a b. (a, b) -> b
snd ((Integer, Int) -> Int) -> (Day -> (Integer, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int)
toOrdinalDate
ynum :: Day -> Int
ynum :: Day -> Int
ynum = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (Day -> Integer) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Int) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Int) -> Integer)
-> (Day -> (Integer, Int)) -> Day -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, 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 -> String
fromRecurrance (Divisible Int
n Recurrance
r) =
ShowS -> Recurrance -> String
fromRecurrance' (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"s divisible by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) Recurrance
r
fromRecurrance Recurrance
r = ShowS -> Recurrance -> String
fromRecurrance' (String
"every " String -> ShowS
forall a. [a] -> [a] -> [a]
++) Recurrance
r
fromRecurrance' :: (String -> String) -> Recurrance -> String
fromRecurrance' :: ShowS -> Recurrance -> String
fromRecurrance' ShowS
a Recurrance
Daily = ShowS
a String
"day"
fromRecurrance' ShowS
a (Weekly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a String
"week")
fromRecurrance' ShowS
a (Monthly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a String
"month")
fromRecurrance' ShowS
a (Yearly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a String
"year")
fromRecurrance' ShowS
a (Divisible Int
_n Recurrance
r) = ShowS -> Recurrance -> String
fromRecurrance' ShowS
a Recurrance
r
onday :: Maybe Int -> String -> String
onday :: Maybe Int -> ShowS
onday (Just Int
n) String
s = String
"on day " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
onday Maybe Int
Nothing String
s = String
s
toRecurrance :: String -> Maybe Recurrance
toRecurrance :: String -> Maybe Recurrance
toRecurrance String
s = case String -> [String]
words String
s of
(String
"every":String
"day":[]) -> Recurrance -> Maybe Recurrance
forall a. a -> Maybe a
Just Recurrance
Daily
(String
"on":String
"day":String
sd:String
"of":String
"every":String
something:[]) -> String -> String -> Maybe Recurrance
withday String
sd String
something
(String
"every":String
something:[]) -> String -> Maybe Recurrance
noday String
something
(String
"days":String
"divisible":String
"by":String
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible (Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall b. (Read b, Ord b, Num b) => String -> Maybe b
getdivisor String
sn Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Recurrance -> Maybe Recurrance
forall (f :: * -> *) a. Applicative f => a -> f a
pure Recurrance
Daily
(String
"on":String
"day":String
sd:String
"of":String
something:String
"divisible":String
"by":String
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall b. (Read b, Ord b, Num b) => String -> Maybe b
getdivisor String
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Recurrance
withday String
sd String
something
(String
"every":String
something:String
"divisible":String
"by":String
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall b. (Read b, Ord b, Num b) => String -> Maybe b
getdivisor String
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Recurrance
noday String
something
(String
something:String
"divisible":String
"by":String
sn:[]) ->
Int -> Recurrance -> Recurrance
Divisible
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall b. (Read b, Ord b, Num b) => String -> Maybe b
getdivisor String
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Recurrance
noday String
something
[String]
_ -> Maybe Recurrance
forall a. Maybe a
Nothing
where
constructor :: String -> Maybe (Maybe Int -> Recurrance)
constructor String
"week" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Weekly
constructor String
"month" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Monthly
constructor String
"year" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Yearly
constructor String
u
| String
"s" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
u = String -> Maybe (Maybe Int -> Recurrance)
constructor (String -> Maybe (Maybe Int -> Recurrance))
-> String -> Maybe (Maybe Int -> Recurrance)
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
dropFromEnd Int
1 String
u
| Bool
otherwise = Maybe (Maybe Int -> Recurrance)
forall a. Maybe a
Nothing
withday :: String -> String -> Maybe Recurrance
withday String
sd String
u = do
Maybe Int -> Recurrance
c <- String -> Maybe (Maybe Int -> Recurrance)
constructor String
u
Int
d <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readish String
sd
Recurrance -> Maybe Recurrance
forall a. a -> Maybe a
Just (Recurrance -> Maybe Recurrance) -> Recurrance -> Maybe Recurrance
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d)
noday :: String -> Maybe Recurrance
noday String
u = do
Maybe Int -> Recurrance
c <- String -> Maybe (Maybe Int -> Recurrance)
constructor String
u
Recurrance -> Maybe Recurrance
forall a. a -> Maybe a
Just (Recurrance -> Maybe Recurrance) -> Recurrance -> Maybe Recurrance
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c Maybe Int
forall a. Maybe a
Nothing
getdivisor :: String -> Maybe b
getdivisor String
sn = do
b
n <- String -> Maybe b
forall a. Read a => String -> Maybe a
readish String
sn
if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0
then b -> Maybe b
forall a. a -> Maybe a
Just b
n
else Maybe b
forall a. Maybe a
Nothing
fromScheduledTime :: ScheduledTime -> String
fromScheduledTime :: ScheduledTime -> String
fromScheduledTime ScheduledTime
AnyTime = String
"any time"
fromScheduledTime (SpecificTime Int
h Int
m) =
Int -> String
forall a. Show a => a -> String
show Int
h' String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (Int -> String
forall a. Show a => a -> String
show Int
m) else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ampm
where
pad :: Int -> ShowS
pad Int
n String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
(Int
h', String
ampm)
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
12, String
"AM")
| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 = (Int
h, String
"AM")
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 = (Int
h, String
"PM")
| Bool
otherwise = (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12, String
"PM")
toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime String
"any time" = ScheduledTime -> Maybe ScheduledTime
forall a. a -> Maybe a
Just ScheduledTime
AnyTime
toScheduledTime String
v = case String -> [String]
words String
v of
(String
s:String
ampm:[])
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ampm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"AM" ->
String -> (Int -> Int) -> Maybe ScheduledTime
go String
s Int -> Int
forall p. (Eq p, Num p) => p -> p
h0
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
ampm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"PM" ->
String -> (Int -> Int) -> Maybe ScheduledTime
go String
s (\Int
h -> (Int -> Int
forall p. (Eq p, Num p) => p -> p
h0 Int
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
| Bool
otherwise -> Maybe ScheduledTime
forall a. Maybe a
Nothing
(String
s:[]) -> String -> (Int -> Int) -> Maybe ScheduledTime
go String
s Int -> Int
forall a. a -> a
id
[String]
_ -> Maybe ScheduledTime
forall a. Maybe a
Nothing
where
h0 :: p -> p
h0 p
h
| p
h p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
12 = p
0
| Bool
otherwise = p
h
go :: String -> (Int -> Int) -> Maybe ScheduledTime
go :: String -> (Int -> Int) -> Maybe ScheduledTime
go String
s Int -> Int
adjust =
let (String
h, String
m) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
s
in Int -> Int -> ScheduledTime
SpecificTime
(Int -> Int -> ScheduledTime)
-> Maybe Int -> Maybe (Int -> ScheduledTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int
adjust (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readish String
h)
Maybe (Int -> ScheduledTime) -> Maybe Int -> Maybe ScheduledTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
m then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 else String -> Maybe Int
forall a. Read a => String -> Maybe a
readish String
m
fromSchedule :: Schedule -> String
fromSchedule :: Schedule -> String
fromSchedule (Schedule Recurrance
recurrance ScheduledTime
scheduledtime) = [String] -> String
unwords
[ Recurrance -> String
fromRecurrance Recurrance
recurrance
, String
"at"
, ScheduledTime -> String
fromScheduledTime ScheduledTime
scheduledtime
]
toSchedule :: String -> Maybe Schedule
toSchedule :: String -> Maybe Schedule
toSchedule = Either String Schedule -> Maybe Schedule
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String Schedule -> Maybe Schedule)
-> (String -> Either String Schedule) -> String -> Maybe Schedule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Schedule
parseSchedule
parseSchedule :: String -> Either String Schedule
parseSchedule :: String -> Either String Schedule
parseSchedule String
s = do
Recurrance
r <- Either String Recurrance
-> (Recurrance -> Either String Recurrance)
-> Maybe Recurrance
-> Either String Recurrance
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Recurrance
forall a b. a -> Either a b
Left (String -> Either String Recurrance)
-> String -> Either String Recurrance
forall a b. (a -> b) -> a -> b
$ String
"bad recurrance: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
recurrance) Recurrance -> Either String Recurrance
forall a b. b -> Either a b
Right
(String -> Maybe Recurrance
toRecurrance String
recurrance)
ScheduledTime
t <- Either String ScheduledTime
-> (ScheduledTime -> Either String ScheduledTime)
-> Maybe ScheduledTime
-> Either String ScheduledTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String ScheduledTime
forall a b. a -> Either a b
Left (String -> Either String ScheduledTime)
-> String -> Either String ScheduledTime
forall a b. (a -> b) -> a -> b
$ String
"bad time of day: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
scheduledtime) ScheduledTime -> Either String ScheduledTime
forall a b. b -> Either a b
Right
(String -> Maybe ScheduledTime
toScheduledTime String
scheduledtime)
Schedule -> Either String Schedule
forall a b. b -> Either a b
Right (Schedule -> Either String Schedule)
-> Schedule -> Either String Schedule
forall a b. (a -> b) -> a -> b
$ Recurrance -> ScheduledTime -> Schedule
Schedule Recurrance
r ScheduledTime
t
where
([String]
rws, [String]
tws) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"at") (String -> [String]
words String
s)
recurrance :: String
recurrance = [String] -> String
unwords [String]
rws
scheduledtime :: String
scheduledtime = [String] -> String
unwords [String]
tws
prop_past_sane :: Bool
prop_past_sane :: Bool
prop_past_sane = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ ((Day, Day) -> Bool) -> [(Day, Day)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Day -> Day -> Bool) -> (Day, Day) -> Bool
forall t t t. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast) ([(Day, Day)]
mplus1 [(Day, Day)] -> [(Day, Day)] -> [(Day, Day)]
forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1)
, ((Day, Day) -> Bool) -> [(Day, Day)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> ((Day, Day) -> Bool) -> (Day, Day) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Day -> Day -> Bool) -> (Day, Day) -> Bool
forall t t t. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast)) (((Day, Day) -> (Day, Day)) -> [(Day, Day)] -> [(Day, Day)]
forall a b. (a -> b) -> [a] -> [b]
map (Day, Day) -> (Day, Day)
forall b a. (b, a) -> (a, b)
swap ([(Day, Day)]
mplus1 [(Day, Day)] -> [(Day, Day)] -> [(Day, Day)]
forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1))
, ((Day, Day) -> Bool) -> [(Day, Day)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Day -> Day -> Bool) -> (Day, Day) -> Bool
forall t t t. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast) [(Day, Day)]
yplus1
, ((Day, Day) -> Bool) -> [(Day, Day)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> ((Day, Day) -> Bool) -> (Day, Day) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Day -> Day -> Bool) -> (Day, Day) -> Bool
forall t t t. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast)) (((Day, Day) -> (Day, Day)) -> [(Day, Day)] -> [(Day, Day)]
forall a b. (a -> b) -> [a] -> [b]
map (Day, Day) -> (Day, Day)
forall b a. (b, a) -> (a, b)
swap [(Day, Day)]
yplus1)
]
where
mplus1 :: [(Day, Day)]
mplus1 =
[ (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
01 Int
15, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
12 Int
15)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
01 Int
15, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
02 Int
15)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
02 Int
15, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
01 Int
15)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
03 Int
01, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
01 Int
15)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
03 Int
01, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
12 Int
15)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2015 Int
01 Int
01, Integer -> Int -> Int -> Day
fromGregorian Integer
2010 Int
01 Int
01)
]
yplus1 :: [(Day, Day)]
yplus1 =
[ (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
01 Int
15, Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
01 Int
16)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2014 Int
01 Int
15, Integer -> Int -> Int -> Day
fromGregorian Integer
2013 Int
01 Int
14)
, (Integer -> Int -> Int -> Day
fromGregorian Integer
2022 Int
12 Int
31, Integer -> Int -> Int -> Day
fromGregorian Integer
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)