{- scheduled activities
 - 
 - Copyright 2013-2014 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

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

{- Some sort of scheduled event. -}
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
	-- ^ Days, Weeks, or Months of the year evenly divisible by a number.
	-- (Divisible Year is years evenly divisible by a number.)
	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

-- | Next time a Schedule should take effect. The NextTimeWindow is used
-- when a Schedule is allowed to start at some point within the window.
data NextTime
	= 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

-- | Calculate the next time that fits a Schedule, based on the
-- last time it occurred, and the current time.
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime :: Schedule -> 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 =
			-- avoid possible infinite recusion
			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
			-- TODO can be done more efficiently than recursing
			| 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

-- Check if the new Day occurs one month or more past the old Day.
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

-- Check if the new Day occurs one year or more past the old Day.
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)

-- extracting various quantities from a Day
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

-- Calendar max values.
maxyday :: Int
maxyday :: Int
maxyday = Int
366 -- with leap days
maxwnum :: Int
maxwnum :: Int
maxwnum = Int
53 -- some years have more than 52
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 -- not used

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 =   -- new date               old date, 1+ months before it
		[ (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 =   -- new date               old date, 1+ years before it
		[ (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)