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
$c== :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS Schedule
readsPrec :: Int -> ReadS Schedule
$creadList :: ReadS [Schedule]
readList :: ReadS [Schedule]
$creadPrec :: ReadPrec Schedule
readPrec :: ReadPrec Schedule
$creadListPrec :: ReadPrec [Schedule]
readListPrec :: ReadPrec [Schedule]
Read, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> [Char]
(Int -> Schedule -> ShowS)
-> (Schedule -> [Char]) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Schedule -> ShowS
showsPrec :: Int -> Schedule -> ShowS
$cshow :: Schedule -> [Char]
show :: Schedule -> [Char]
$cshowList :: [Schedule] -> ShowS
showList :: [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
$ccompare :: Schedule -> Schedule -> Ordering
compare :: Schedule -> Schedule -> Ordering
$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
>= :: Schedule -> Schedule -> Bool
$cmax :: Schedule -> Schedule -> Schedule
max :: Schedule -> Schedule -> Schedule
$cmin :: Schedule -> Schedule -> Schedule
min :: Schedule -> Schedule -> 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
$c== :: Recurrance -> Recurrance -> Bool
== :: Recurrance -> Recurrance -> Bool
$c/= :: Recurrance -> Recurrance -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS Recurrance
readsPrec :: Int -> ReadS Recurrance
$creadList :: ReadS [Recurrance]
readList :: ReadS [Recurrance]
$creadPrec :: ReadPrec Recurrance
readPrec :: ReadPrec Recurrance
$creadListPrec :: ReadPrec [Recurrance]
readListPrec :: ReadPrec [Recurrance]
Read, Int -> Recurrance -> ShowS
[Recurrance] -> ShowS
Recurrance -> [Char]
(Int -> Recurrance -> ShowS)
-> (Recurrance -> [Char])
-> ([Recurrance] -> ShowS)
-> Show Recurrance
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recurrance -> ShowS
showsPrec :: Int -> Recurrance -> ShowS
$cshow :: Recurrance -> [Char]
show :: Recurrance -> [Char]
$cshowList :: [Recurrance] -> ShowS
showList :: [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
$ccompare :: Recurrance -> Recurrance -> Ordering
compare :: Recurrance -> Recurrance -> Ordering
$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
>= :: Recurrance -> Recurrance -> Bool
$cmax :: Recurrance -> Recurrance -> Recurrance
max :: Recurrance -> Recurrance -> Recurrance
$cmin :: Recurrance -> Recurrance -> Recurrance
min :: Recurrance -> Recurrance -> 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
$c== :: ScheduledTime -> ScheduledTime -> Bool
== :: ScheduledTime -> ScheduledTime -> Bool
$c/= :: ScheduledTime -> ScheduledTime -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS ScheduledTime
readsPrec :: Int -> ReadS ScheduledTime
$creadList :: ReadS [ScheduledTime]
readList :: ReadS [ScheduledTime]
$creadPrec :: ReadPrec ScheduledTime
readPrec :: ReadPrec ScheduledTime
$creadListPrec :: ReadPrec [ScheduledTime]
readListPrec :: ReadPrec [ScheduledTime]
Read, Int -> ScheduledTime -> ShowS
[ScheduledTime] -> ShowS
ScheduledTime -> [Char]
(Int -> ScheduledTime -> ShowS)
-> (ScheduledTime -> [Char])
-> ([ScheduledTime] -> ShowS)
-> Show ScheduledTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduledTime -> ShowS
showsPrec :: Int -> ScheduledTime -> ShowS
$cshow :: ScheduledTime -> [Char]
show :: ScheduledTime -> [Char]
$cshowList :: [ScheduledTime] -> ShowS
showList :: [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
$ccompare :: ScheduledTime -> ScheduledTime -> Ordering
compare :: ScheduledTime -> ScheduledTime -> Ordering
$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
>= :: ScheduledTime -> ScheduledTime -> Bool
$cmax :: ScheduledTime -> ScheduledTime -> ScheduledTime
max :: ScheduledTime -> ScheduledTime -> ScheduledTime
$cmin :: ScheduledTime -> ScheduledTime -> ScheduledTime
min :: ScheduledTime -> ScheduledTime -> 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
$c== :: NextTime -> NextTime -> Bool
== :: NextTime -> NextTime -> Bool
$c/= :: NextTime -> NextTime -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS NextTime
readsPrec :: Int -> ReadS NextTime
$creadList :: ReadS [NextTime]
readList :: ReadS [NextTime]
$creadPrec :: ReadPrec NextTime
readPrec :: ReadPrec NextTime
$creadListPrec :: ReadPrec [NextTime]
readListPrec :: ReadPrec [NextTime]
Read, Int -> NextTime -> ShowS
[NextTime] -> ShowS
NextTime -> [Char]
(Int -> NextTime -> ShowS)
-> (NextTime -> [Char]) -> ([NextTime] -> ShowS) -> Show NextTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NextTime -> ShowS
showsPrec :: Int -> NextTime -> ShowS
$cshow :: NextTime -> [Char]
show :: NextTime -> [Char]
$cshowList :: [NextTime] -> ShowS
showList :: [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 a. a -> IO a
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 a. a -> Maybe a
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 =
[Char] -> Maybe NextTime
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe NextTime) -> [Char] -> Maybe NextTime
forall a b. (a -> b) -> a -> b
$ [Char]
"bug: calcNextTime did not find a time within 100 years to run " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
(Schedule, Maybe LocalTime, LocalTime) -> [Char]
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 -> 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
$ Year -> Day -> Day
addDays Year
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 -> Year -> Maybe NextTime
skip Year
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 (Year -> Day -> Day
addDays Year
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 (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
| 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 -> Year -> Maybe NextTime
skip Year
1
Yearly Maybe Int
Nothing
| Bool
afterday -> Year -> Maybe NextTime
skip Year
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 -> Year -> Maybe NextTime
skip Year
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
$ Year -> Day -> Day
addDays Year
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
$
Year -> Day -> Day
addDays (Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Year) -> Int -> Year
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 Year -> Maybe NextTime
skip Year
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 -> Year -> Maybe NextTime
skip Year
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 Year -> Maybe NextTime
skip Year
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 -> Year -> Maybe NextTime
skip Year
1
Divisible Int
n r' :: Recurrance
r'@Recurrance
Daily -> Int -> Recurrance -> (Day -> Int) -> Maybe Int -> Maybe NextTime
forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> 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 {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> 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 {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> 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 {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> 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 :: 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 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 Bool -> Bool -> Bool
&& Bool -> (b -> Bool) -> Maybe b -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<=) Maybe b
mmax =
Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r' (b -> b -> Bool
forall {a}. Integral a => a -> a -> Bool
divisible b
n (b -> Bool) -> (Day -> b) -> Day -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> b
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 = Year -> Int -> Int -> Day
fromGregorian Year
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
(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
yYear -> Year -> Year
forall a. Num a => a -> a -> a
+Year
1) Int
m Int
d Day -> Day -> Bool
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 = (Year, Int, Int) -> Int
forall a b c. (a, b, c) -> c
thd3 ((Year, Int, Int) -> Int)
-> (Day -> (Year, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
wnum :: Day -> Int
wnum :: Day -> Int
wnum = (Year, Int, Int) -> Int
forall a b c. (a, b, c) -> b
snd3 ((Year, Int, Int) -> Int)
-> (Day -> (Year, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
mday :: Day -> Int
mday :: Day -> Int
mday = (Year, Int, Int) -> Int
forall a b c. (a, b, c) -> c
thd3 ((Year, Int, Int) -> Int)
-> (Day -> (Year, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
mnum :: Day -> Int
mnum :: Day -> Int
mnum = (Year, Int, Int) -> Int
forall a b c. (a, b, c) -> b
snd3 ((Year, Int, Int) -> Int)
-> (Day -> (Year, Int, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
yday :: Day -> Int
yday :: Day -> Int
yday = (Year, Int) -> Int
forall a b. (a, b) -> b
snd ((Year, Int) -> Int) -> (Day -> (Year, Int)) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int)
toOrdinalDate
ynum :: Day -> Int
ynum :: Day -> Int
ynum = Year -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Year -> Int) -> (Day -> Year) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Year, Int) -> Year
forall a b. (a, b) -> a
fst ((Year, Int) -> Year) -> (Day -> (Year, Int)) -> Day -> Year
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' ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"s divisible by " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) Recurrance
r
fromRecurrance Recurrance
r = ShowS -> Recurrance -> [Char]
fromRecurrance' ([Char]
"every " [Char] -> ShowS
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" of " [Char] -> ShowS
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":[]) -> Recurrance -> Maybe Recurrance
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 (Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Recurrance -> Maybe Recurrance
forall a. a -> Maybe a
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
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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
(Int -> Recurrance -> Recurrance)
-> Maybe Int -> Maybe (Recurrance -> Recurrance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
Maybe (Recurrance -> Recurrance)
-> Maybe Recurrance -> Maybe Recurrance
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Recurrance
noday [Char]
something
[[Char]]
_ -> Maybe Recurrance
forall a. Maybe a
Nothing
where
constructor :: [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
"week" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Weekly
constructor [Char]
"month" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Monthly
constructor [Char]
"year" = (Maybe Int -> Recurrance) -> Maybe (Maybe Int -> Recurrance)
forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Yearly
constructor [Char]
u
| [Char]
"s" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
u = [Char] -> Maybe (Maybe Int -> Recurrance)
constructor ([Char] -> Maybe (Maybe Int -> Recurrance))
-> [Char] -> Maybe (Maybe Int -> Recurrance)
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
dropFromEnd Int
1 [Char]
u
| Bool
otherwise = Maybe (Maybe Int -> Recurrance)
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 <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readish [Char]
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 :: [Char] -> Maybe Recurrance
noday [Char]
u = do
Maybe Int -> Recurrance
c <- [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
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 :: [Char] -> Maybe b
getdivisor [Char]
sn = do
b
n <- [Char] -> Maybe b
forall a. Read a => [Char] -> Maybe a
readish [Char]
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 -> [Char]
fromScheduledTime ScheduledTime
AnyTime = [Char]
"any time"
fromScheduledTime (SpecificTime Int
h Int
m) =
Int -> [Char]
forall a. Show a => a -> [Char]
show Int
h' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
m) else [Char]
"") [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ampm
where
pad :: Int -> ShowS
pad Int
n [Char]
s = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
(Int
h', [Char]
ampm)
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
12, [Char]
"AM")
| Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 = (Int
h, [Char]
"AM")
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 = (Int
h, [Char]
"PM")
| Bool
otherwise = (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12, [Char]
"PM")
toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime :: [Char] -> Maybe ScheduledTime
toScheduledTime [Char]
"any time" = ScheduledTime -> Maybe ScheduledTime
forall a. a -> Maybe a
Just ScheduledTime
AnyTime
toScheduledTime [Char]
v = case [Char] -> [[Char]]
words [Char]
v of
([Char]
s:[Char]
ampm:[])
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"AM" ->
[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s Int -> Int
forall {a}. (Eq a, Num a) => a -> a
h0
| (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"PM" ->
[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s (\Int
h -> (Int -> Int
forall {a}. (Eq a, Num a) => a -> a
h0 Int
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
| Bool
otherwise -> Maybe ScheduledTime
forall a. Maybe a
Nothing
([Char]
s:[]) -> [Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s Int -> Int
forall a. a -> a
id
[[Char]]
_ -> Maybe ScheduledTime
forall a. Maybe a
Nothing
where
h0 :: a -> a
h0 a
h
| a
h a -> a -> Bool
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) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
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
<$> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readish [Char]
h)
Maybe (Int -> ScheduledTime) -> Maybe Int -> Maybe ScheduledTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
m then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 else [Char] -> Maybe Int
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 = Either [Char] Schedule -> Maybe Schedule
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] Schedule -> Maybe Schedule)
-> ([Char] -> Either [Char] Schedule) -> [Char] -> Maybe Schedule
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 <- Either [Char] Recurrance
-> (Recurrance -> Either [Char] Recurrance)
-> Maybe Recurrance
-> Either [Char] Recurrance
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Recurrance
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Recurrance)
-> [Char] -> Either [Char] Recurrance
forall a b. (a -> b) -> a -> b
$ [Char]
"bad recurrance: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
recurrance) Recurrance -> Either [Char] Recurrance
forall a b. b -> Either a b
Right
([Char] -> Maybe Recurrance
toRecurrance [Char]
recurrance)
ScheduledTime
t <- Either [Char] ScheduledTime
-> (ScheduledTime -> Either [Char] ScheduledTime)
-> Maybe ScheduledTime
-> Either [Char] ScheduledTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] ScheduledTime
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ScheduledTime)
-> [Char] -> Either [Char] ScheduledTime
forall a b. (a -> b) -> a -> b
$ [Char]
"bad time of day: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
scheduledtime) ScheduledTime -> Either [Char] ScheduledTime
forall a b. b -> Either a b
Right
([Char] -> Maybe ScheduledTime
toScheduledTime [Char]
scheduledtime)
Schedule -> Either [Char] Schedule
forall a b. b -> Either a b
Right (Schedule -> Either [Char] Schedule)
-> Schedule -> Either [Char] Schedule
forall a b. (a -> b) -> a -> b
$ Recurrance -> ScheduledTime -> Schedule
Schedule Recurrance
r ScheduledTime
t
where
([[Char]]
rws, [[Char]]
tws) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
separate ([Char] -> [Char] -> Bool
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 = [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 =
[ (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)