{- 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c== :: Schedule -> Schedule -> Bool
Eq, ReadPrec [Schedule]
ReadPrec Schedule
Int -> ReadS Schedule
ReadS [Schedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Schedule]
$creadListPrec :: ReadPrec [Schedule]
readPrec :: ReadPrec Schedule
$creadPrec :: ReadPrec Schedule
readList :: ReadS [Schedule]
$creadList :: ReadS [Schedule]
readsPrec :: Int -> ReadS Schedule
$creadsPrec :: Int -> ReadS Schedule
Read, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Schedule] -> ShowS
$cshowList :: [Schedule] -> ShowS
show :: Schedule -> [Char]
$cshow :: Schedule -> [Char]
showsPrec :: Int -> Schedule -> ShowS
$cshowsPrec :: Int -> Schedule -> ShowS
Show, Eq Schedule
Schedule -> Schedule -> Bool
Schedule -> Schedule -> Ordering
Schedule -> Schedule -> Schedule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Schedule -> Schedule -> Schedule
$cmin :: Schedule -> Schedule -> Schedule
max :: Schedule -> Schedule -> Schedule
$cmax :: Schedule -> Schedule -> Schedule
>= :: Schedule -> Schedule -> Bool
$c>= :: Schedule -> Schedule -> Bool
> :: Schedule -> Schedule -> Bool
$c> :: Schedule -> Schedule -> Bool
<= :: Schedule -> Schedule -> Bool
$c<= :: Schedule -> Schedule -> Bool
< :: Schedule -> Schedule -> Bool
$c< :: Schedule -> Schedule -> Bool
compare :: Schedule -> Schedule -> Ordering
$ccompare :: Schedule -> Schedule -> Ordering
Ord)

data Recurrance
	= Daily
	| Weekly (Maybe WeekDay)
	| Monthly (Maybe MonthDay)
	| Yearly (Maybe YearDay)
	| Divisible Int Recurrance
	-- ^ 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recurrance -> Recurrance -> Bool
$c/= :: Recurrance -> Recurrance -> Bool
== :: Recurrance -> Recurrance -> Bool
$c== :: Recurrance -> Recurrance -> Bool
Eq, ReadPrec [Recurrance]
ReadPrec Recurrance
Int -> ReadS Recurrance
ReadS [Recurrance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Recurrance]
$creadListPrec :: ReadPrec [Recurrance]
readPrec :: ReadPrec Recurrance
$creadPrec :: ReadPrec Recurrance
readList :: ReadS [Recurrance]
$creadList :: ReadS [Recurrance]
readsPrec :: Int -> ReadS Recurrance
$creadsPrec :: Int -> ReadS Recurrance
Read, Int -> Recurrance -> ShowS
[Recurrance] -> ShowS
Recurrance -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Recurrance] -> ShowS
$cshowList :: [Recurrance] -> ShowS
show :: Recurrance -> [Char]
$cshow :: Recurrance -> [Char]
showsPrec :: Int -> Recurrance -> ShowS
$cshowsPrec :: Int -> Recurrance -> ShowS
Show, Eq Recurrance
Recurrance -> Recurrance -> Bool
Recurrance -> Recurrance -> Ordering
Recurrance -> Recurrance -> Recurrance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Recurrance -> Recurrance -> Recurrance
$cmin :: Recurrance -> Recurrance -> Recurrance
max :: Recurrance -> Recurrance -> Recurrance
$cmax :: Recurrance -> Recurrance -> Recurrance
>= :: Recurrance -> Recurrance -> Bool
$c>= :: Recurrance -> Recurrance -> Bool
> :: Recurrance -> Recurrance -> Bool
$c> :: Recurrance -> Recurrance -> Bool
<= :: Recurrance -> Recurrance -> Bool
$c<= :: Recurrance -> Recurrance -> Bool
< :: Recurrance -> Recurrance -> Bool
$c< :: Recurrance -> Recurrance -> Bool
compare :: Recurrance -> Recurrance -> Ordering
$ccompare :: Recurrance -> Recurrance -> Ordering
Ord)

type WeekDay = Int
type MonthDay = Int
type YearDay = Int

data ScheduledTime
	= AnyTime
	| SpecificTime Hour Minute
	deriving (ScheduledTime -> ScheduledTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScheduledTime -> ScheduledTime -> Bool
$c/= :: ScheduledTime -> ScheduledTime -> Bool
== :: ScheduledTime -> ScheduledTime -> Bool
$c== :: ScheduledTime -> ScheduledTime -> Bool
Eq, ReadPrec [ScheduledTime]
ReadPrec ScheduledTime
Int -> ReadS ScheduledTime
ReadS [ScheduledTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScheduledTime]
$creadListPrec :: ReadPrec [ScheduledTime]
readPrec :: ReadPrec ScheduledTime
$creadPrec :: ReadPrec ScheduledTime
readList :: ReadS [ScheduledTime]
$creadList :: ReadS [ScheduledTime]
readsPrec :: Int -> ReadS ScheduledTime
$creadsPrec :: Int -> ReadS ScheduledTime
Read, Int -> ScheduledTime -> ShowS
[ScheduledTime] -> ShowS
ScheduledTime -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ScheduledTime] -> ShowS
$cshowList :: [ScheduledTime] -> ShowS
show :: ScheduledTime -> [Char]
$cshow :: ScheduledTime -> [Char]
showsPrec :: Int -> ScheduledTime -> ShowS
$cshowsPrec :: Int -> ScheduledTime -> ShowS
Show, Eq ScheduledTime
ScheduledTime -> ScheduledTime -> Bool
ScheduledTime -> ScheduledTime -> Ordering
ScheduledTime -> ScheduledTime -> ScheduledTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScheduledTime -> ScheduledTime -> ScheduledTime
$cmin :: ScheduledTime -> ScheduledTime -> ScheduledTime
max :: ScheduledTime -> ScheduledTime -> ScheduledTime
$cmax :: ScheduledTime -> ScheduledTime -> ScheduledTime
>= :: ScheduledTime -> ScheduledTime -> Bool
$c>= :: ScheduledTime -> ScheduledTime -> Bool
> :: ScheduledTime -> ScheduledTime -> Bool
$c> :: ScheduledTime -> ScheduledTime -> Bool
<= :: ScheduledTime -> ScheduledTime -> Bool
$c<= :: ScheduledTime -> ScheduledTime -> Bool
< :: ScheduledTime -> ScheduledTime -> Bool
$c< :: ScheduledTime -> ScheduledTime -> Bool
compare :: ScheduledTime -> ScheduledTime -> Ordering
$ccompare :: ScheduledTime -> ScheduledTime -> Ordering
Ord)

type Hour = Int
type Minute = Int

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NextTime -> NextTime -> Bool
$c/= :: NextTime -> NextTime -> Bool
== :: NextTime -> NextTime -> Bool
$c== :: NextTime -> NextTime -> Bool
Eq, ReadPrec [NextTime]
ReadPrec NextTime
Int -> ReadS NextTime
ReadS [NextTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NextTime]
$creadListPrec :: ReadPrec [NextTime]
readPrec :: ReadPrec NextTime
$creadPrec :: ReadPrec NextTime
readList :: ReadS [NextTime]
$creadList :: ReadS [NextTime]
readsPrec :: Int -> ReadS NextTime
$creadsPrec :: Int -> ReadS NextTime
Read, Int -> NextTime -> ShowS
[NextTime] -> ShowS
NextTime -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NextTime] -> ShowS
$cshowList :: [NextTime] -> ShowS
show :: NextTime -> [Char]
$cshow :: NextTime -> [Char]
showsPrec :: Int -> NextTime -> ShowS
$cshowsPrec :: Int -> NextTime -> ShowS
Show)

startTime :: NextTime -> LocalTime
startTime :: NextTime -> LocalTime
startTime (NextTimeExactly LocalTime
t) = LocalTime
t
startTime (NextTimeWindow LocalTime
t LocalTime
_) = LocalTime
t

nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
nextTime :: Schedule -> Maybe LocalTime -> IO (Maybe NextTime)
nextTime Schedule
schedule Maybe LocalTime
lasttime = do
	UTCTime
now <- IO UTCTime
getCurrentTime
	TimeZone
tz <- UTCTime -> IO TimeZone
getTimeZone UTCTime
now
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
calcNextTime Schedule
schedule Maybe LocalTime
lasttime forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
now

-- | 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 forall a. Eq a => a -> a -> Bool
== ScheduledTime
AnyTime = do
		NextTime
next <- Bool -> Maybe NextTime
findfromtoday Bool
True
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case NextTime
next of
			NextTimeWindow LocalTime
_ LocalTime
_ -> NextTime
next
			NextTimeExactly LocalTime
t -> Day -> Day -> NextTime
window (LocalTime -> Day
localDay LocalTime
t) (LocalTime -> Day
localDay LocalTime
t)
	| Bool
otherwise = LocalTime -> NextTime
NextTimeExactly forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Maybe NextTime
findfromtoday Bool
False
  where
	findfromtoday :: Bool -> Maybe NextTime
findfromtoday Bool
anytime = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
recurrance Bool
afterday Day
today
	  where
		today :: Day
today = LocalTime -> Day
localDay LocalTime
currenttime
		afterday :: Bool
afterday = Bool
sameaslastrun Bool -> Bool -> Bool
|| Bool
toolatetoday
		toolatetoday :: Bool
toolatetoday = Bool -> Bool
not Bool
anytime Bool -> Bool -> Bool
&& LocalTime -> TimeOfDay
localTimeOfDay LocalTime
currenttime forall a. Ord a => a -> a -> Bool
>= TimeOfDay
nexttime
		sameaslastrun :: Bool
sameaslastrun = Maybe Day
lastrun forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Day
today
	lastrun :: Maybe Day
lastrun = LocalTime -> Day
localDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalTime
lasttime
	nexttime :: TimeOfDay
nexttime = case ScheduledTime
scheduledtime of
		ScheduledTime
AnyTime -> Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0
		SpecificTime Int
h Int
m -> Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
0
	exactly :: Day -> NextTime
exactly Day
d = LocalTime -> NextTime
NextTimeExactly forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
d TimeOfDay
nexttime
	window :: Day -> Day -> NextTime
window Day
startd Day
endd = LocalTime -> LocalTime -> NextTime
NextTimeWindow
		(Day -> TimeOfDay -> LocalTime
LocalTime Day
startd TimeOfDay
nexttime)
		(Day -> TimeOfDay -> LocalTime
LocalTime Day
endd (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 Pico
0))
	findfrom :: Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
afterday Day
candidate
		| Day -> Int
ynum Day
candidate forall a. Ord a => a -> a -> Bool
> (Day -> Int
ynum (LocalTime -> Day
localDay LocalTime
currenttime)) forall a. Num a => a -> a -> a
+ Int
100 =
			-- avoid possible infinite recusion
			forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"bug: calcNextTime did not find a time within 100 years to run " forall a. [a] -> [a] -> [a]
++
			forall a. Show a => a -> [Char]
show (Schedule
schedule, Maybe LocalTime
lasttime, LocalTime
currenttime)
		| Bool
otherwise = Recurrance -> Bool -> Day -> Maybe NextTime
findfromChecked Recurrance
r Bool
afterday Day
candidate
	findfromChecked :: Recurrance -> Bool -> Day -> Maybe NextTime
findfromChecked Recurrance
r Bool
afterday Day
candidate = case Recurrance
r of
		Recurrance
Daily
			| Bool
afterday -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
1 Day
candidate
			| Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
		Weekly Maybe Int
Nothing
			| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
			| Bool
otherwise -> case (Day -> Int
wday forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
lastrun, Day -> Int
wday Day
candidate) of
				(Maybe Int
Nothing, Int
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Year -> Day -> Day
addDays Year
6 Day
candidate)
				(Just Int
old, Int
curr)
					| Int
old forall a. Eq a => a -> a -> Bool
== Int
curr -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Year -> Day -> Day
addDays Year
6 Day
candidate)
					| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
		Monthly Maybe Int
Nothing
			| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
			| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneMonthPast`) Maybe Day
lastrun ->
				forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfMonth Day
candidate)
			| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
		Yearly Maybe Int
Nothing
			| Bool
afterday -> Year -> Maybe NextTime
skip Year
1
			| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day
candidate Day -> Day -> Bool
`oneYearPast`) Maybe Day
lastrun ->
				forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> Day -> NextTime
window Day
candidate (Day -> Day
endOfYear Day
candidate)
			| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
		Weekly (Just Int
w)
			| Int
w forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
w forall a. Ord a => a -> a -> Bool
> Int
maxwday -> forall a. Maybe a
Nothing
			| Int
w forall a. Eq a => a -> a -> Bool
== Day -> Int
wday Day
candidate -> if Bool
afterday
				then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays Year
7 Day
candidate
				else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
			| Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly forall a b. (a -> b) -> a -> b
$
				Year -> Day -> Day
addDays (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
w forall a. Num a => a -> a -> a
- Day -> Int
wday Day
candidate) forall a. Integral a => a -> a -> a
`mod` Int
7) Day
candidate
		Monthly (Just Int
m)
			| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
m forall a. Ord a => a -> a -> Bool
> Int
maxmday -> forall a. Maybe a
Nothing
			-- TODO can be done more efficiently than recursing
			| Int
m forall a. Eq a => a -> a -> Bool
== Day -> Int
mday Day
candidate -> if Bool
afterday
				then Year -> Maybe NextTime
skip Year
1
				else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
			| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
		Yearly (Just Int
y)
			| Int
y forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
y forall a. Ord a => a -> a -> Bool
> Int
maxyday -> forall a. Maybe a
Nothing
			| Int
y forall a. Eq a => a -> a -> Bool
== Day -> Int
yday Day
candidate -> if Bool
afterday
				then Year -> Maybe NextTime
skip Year
365
				else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Day -> NextTime
exactly Day
candidate
			| Bool
otherwise -> Year -> Maybe NextTime
skip Year
1
		Divisible Int
n r' :: Recurrance
r'@Recurrance
Daily -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
yday (forall a. a -> Maybe a
Just Int
maxyday)
		Divisible Int
n r' :: Recurrance
r'@(Weekly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
wnum (forall a. a -> Maybe a
Just Int
maxwnum)
		Divisible Int
n r' :: Recurrance
r'@(Monthly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
mnum (forall a. a -> Maybe a
Just Int
maxmnum)
		Divisible Int
n r' :: Recurrance
r'@(Yearly Maybe Int
_) -> forall {b}.
Integral b =>
b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv Int
n Recurrance
r' Day -> Int
ynum forall a. Maybe a
Nothing
		Divisible Int
_ r' :: Recurrance
r'@(Divisible Int
_ Recurrance
_) -> Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r' Bool
afterday Day
candidate
	  where
		skip :: Year -> Maybe NextTime
skip Year
n = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
False (Year -> Day -> Day
addDays Year
n Day
candidate)
		handlediv :: b -> Recurrance -> (Day -> b) -> Maybe b -> Maybe NextTime
handlediv b
n Recurrance
r' Day -> b
getval Maybe b
mmax
			| b
n forall a. Ord a => a -> a -> Bool
> b
0 Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (b
n forall a. Ord a => a -> a -> Bool
<=) Maybe b
mmax =
				Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r' (forall {a}. Integral a => a -> a -> Bool
divisible b
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> b
getval) Bool
afterday Day
candidate
			| Bool
otherwise = forall a. Maybe a
Nothing
	findfromwhere :: Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
afterday Day
candidate
		| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Day -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> Day
getday) Maybe NextTime
next = Maybe NextTime
next
		| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (Recurrance -> (Day -> Bool) -> Bool -> Day -> Maybe NextTime
findfromwhere Recurrance
r Day -> Bool
p Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> Day
getday) Maybe NextTime
next
	  where
		next :: Maybe NextTime
next = Recurrance -> Bool -> Day -> Maybe NextTime
findfrom Recurrance
r Bool
afterday Day
candidate
		getday :: NextTime -> Day
getday = LocalTime -> Day
localDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextTime -> LocalTime
startTime
	divisible :: a -> a -> Bool
divisible a
n a
v = a
v forall a. Integral a => a -> a -> a
`rem` a
n forall a. Eq a => a -> a -> Bool
== a
0

-- 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 = Year -> Int -> Int -> Day
fromGregorian Year
y (Int
mforall a. Num a => a -> a -> a
+Int
1) Int
d forall a. Ord a => a -> a -> Bool
<= Day
new
  where
	(Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
old

-- 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 = Year -> Int -> Int -> Day
fromGregorian (Year
yforall a. Num a => a -> a -> a
+Year
1) Int
m Int
d forall a. Ord a => a -> a -> Bool
<= Day
new
  where
	(Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
old

endOfMonth :: Day -> Day
endOfMonth :: Day -> Day
endOfMonth Day
day =
	let (Year
y,Int
m,Int
_d) = Day -> (Year, Int, Int)
toGregorian Day
day
	in Year -> Int -> Int -> Day
fromGregorian Year
y Int
m (Year -> Int -> Int
gregorianMonthLength Year
y Int
m)

endOfYear :: Day -> Day
endOfYear :: Day -> Day
endOfYear Day
day =
	let (Year
y,Int
_m,Int
_d) = Day -> (Year, Int, Int)
toGregorian Day
day
	in Day -> Day
endOfMonth (Year -> Int -> Int -> Day
fromGregorian Year
y Int
maxmnum Int
1)

-- extracting various quantities from a Day
wday :: Day -> Int
wday :: Day -> Int
wday = forall a b c. (a, b, c) -> c
thd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
wnum :: Day -> Int
wnum :: Day -> Int
wnum = forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toWeekDate
mday :: Day -> Int
mday :: Day -> Int
mday = forall a b c. (a, b, c) -> c
thd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
mnum :: Day -> Int
mnum :: Day -> Int
mnum = forall a b c. (a, b, c) -> b
snd3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int, Int)
toGregorian
yday :: Day -> Int
yday :: Day -> Int
yday = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int)
toOrdinalDate
ynum :: Day -> Int
ynum :: Day -> Int
ynum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Year, Int)
toOrdinalDate

-- 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 -> [Char]
fromRecurrance (Divisible Int
n Recurrance
r) =
	ShowS -> Recurrance -> [Char]
fromRecurrance' (forall a. [a] -> [a] -> [a]
++ [Char]
"s divisible by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n) Recurrance
r
fromRecurrance Recurrance
r = ShowS -> Recurrance -> [Char]
fromRecurrance' ([Char]
"every " forall a. [a] -> [a] -> [a]
++) Recurrance
r

fromRecurrance' :: (String -> String) -> Recurrance -> String
fromRecurrance' :: ShowS -> Recurrance -> [Char]
fromRecurrance' ShowS
a Recurrance
Daily = ShowS
a [Char]
"day"
fromRecurrance' ShowS
a (Weekly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"week")
fromRecurrance' ShowS
a (Monthly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"month")
fromRecurrance' ShowS
a (Yearly Maybe Int
n) = Maybe Int -> ShowS
onday Maybe Int
n (ShowS
a [Char]
"year")
fromRecurrance' ShowS
a (Divisible Int
_n Recurrance
r) = ShowS -> Recurrance -> [Char]
fromRecurrance' ShowS
a Recurrance
r -- not used

onday :: Maybe Int -> String -> String
onday :: Maybe Int -> ShowS
onday (Just Int
n) [Char]
s = [Char]
"on day " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
" of " forall a. [a] -> [a] -> [a]
++ [Char]
s
onday Maybe Int
Nothing [Char]
s = [Char]
s

toRecurrance :: String -> Maybe Recurrance
toRecurrance :: [Char] -> Maybe Recurrance
toRecurrance [Char]
s = case [Char] -> [[Char]]
words [Char]
s of
	([Char]
"every":[Char]
"day":[]) -> forall a. a -> Maybe a
Just Recurrance
Daily
	([Char]
"on":[Char]
"day":[Char]
sd:[Char]
"of":[Char]
"every":[Char]
something:[]) -> [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
something
	([Char]
"every":[Char]
something:[]) -> [Char] -> Maybe Recurrance
noday [Char]
something
	([Char]
"days":[Char]
"divisible":[Char]
"by":[Char]
sn:[]) -> 
		Int -> Recurrance -> Recurrance
Divisible forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Recurrance
Daily
	([Char]
"on":[Char]
"day":[Char]
sd:[Char]
"of":[Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) -> 
		Int -> Recurrance -> Recurrance
Divisible
			forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
			forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
something
	([Char]
"every":[Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) -> 
		Int -> Recurrance -> Recurrance
Divisible
			forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
			forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Recurrance
noday [Char]
something
	([Char]
something:[Char]
"divisible":[Char]
"by":[Char]
sn:[]) -> 
		Int -> Recurrance -> Recurrance
Divisible
			forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. (Read b, Ord b, Num b) => [Char] -> Maybe b
getdivisor [Char]
sn
			forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Recurrance
noday [Char]
something
	[[Char]]
_ -> forall a. Maybe a
Nothing
  where
	constructor :: [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
"week" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Weekly
	constructor [Char]
"month" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Monthly
	constructor [Char]
"year" = forall a. a -> Maybe a
Just Maybe Int -> Recurrance
Yearly
	constructor [Char]
u
		| [Char]
"s" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
u = [Char] -> Maybe (Maybe Int -> Recurrance)
constructor forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
dropFromEnd Int
1 [Char]
u
		| Bool
otherwise = forall a. Maybe a
Nothing
	withday :: [Char] -> [Char] -> Maybe Recurrance
withday [Char]
sd [Char]
u = do
		Maybe Int -> Recurrance
c <- [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
u
		Int
d <- forall a. Read a => [Char] -> Maybe a
readish [Char]
sd
		forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c (forall a. a -> Maybe a
Just Int
d)
	noday :: [Char] -> Maybe Recurrance
noday [Char]
u = do
		Maybe Int -> Recurrance
c <- [Char] -> Maybe (Maybe Int -> Recurrance)
constructor [Char]
u
		forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Int -> Recurrance
c forall a. Maybe a
Nothing
	getdivisor :: [Char] -> Maybe b
getdivisor [Char]
sn = do
		b
n <- forall a. Read a => [Char] -> Maybe a
readish [Char]
sn
		if b
n forall a. Ord a => a -> a -> Bool
> b
0
			then forall a. a -> Maybe a
Just b
n
			else forall a. Maybe a
Nothing

fromScheduledTime :: ScheduledTime -> String
fromScheduledTime :: ScheduledTime -> [Char]
fromScheduledTime ScheduledTime
AnyTime = [Char]
"any time"
fromScheduledTime (SpecificTime Int
h Int
m) = 
	forall a. Show a => a -> [Char]
show Int
h' forall a. [a] -> [a] -> [a]
++ (if Int
m forall a. Ord a => a -> a -> Bool
> Int
0 then [Char]
":" forall a. [a] -> [a] -> [a]
++ Int -> ShowS
pad Int
2 (forall a. Show a => a -> [Char]
show Int
m) else [Char]
"") forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
ampm
  where
	pad :: Int -> ShowS
pad Int
n [Char]
s = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
s
	(Int
h', [Char]
ampm)
		| Int
h forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
12, [Char]
"AM")
		| Int
h forall a. Ord a => a -> a -> Bool
< Int
12 = (Int
h, [Char]
"AM")
		| Int
h forall a. Eq a => a -> a -> Bool
== Int
12 = (Int
h, [Char]
"PM")
		| Bool
otherwise = (Int
h forall a. Num a => a -> a -> a
- Int
12, [Char]
"PM")

toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime :: [Char] -> Maybe ScheduledTime
toScheduledTime [Char]
"any time" = forall a. a -> Maybe a
Just ScheduledTime
AnyTime
toScheduledTime [Char]
v = case [Char] -> [[Char]]
words [Char]
v of
	([Char]
s:[Char]
ampm:[])
		| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm forall a. Eq a => a -> a -> Bool
== [Char]
"AM" ->
			[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s forall {a}. (Eq a, Num a) => a -> a
h0
		| forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
ampm forall a. Eq a => a -> a -> Bool
== [Char]
"PM" ->
			[Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s (\Int
h -> (forall {a}. (Eq a, Num a) => a -> a
h0 Int
h) forall a. Num a => a -> a -> a
+ Int
12)
		| Bool
otherwise -> forall a. Maybe a
Nothing
	([Char]
s:[]) -> [Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s forall a. a -> a
id
	[[Char]]
_ -> forall a. Maybe a
Nothing
  where
	h0 :: a -> a
h0 a
h
		| a
h forall a. Eq a => a -> a -> Bool
== a
12 = a
0
		| Bool
otherwise = a
h
	go :: String -> (Int -> Int) -> Maybe ScheduledTime
	go :: [Char] -> (Int -> Int) -> Maybe ScheduledTime
go [Char]
s Int -> Int
adjust =
		let ([Char]
h, [Char]
m) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
s
		in Int -> Int -> ScheduledTime
SpecificTime
			forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int
adjust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
readish [Char]
h)
			forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
m then forall a. a -> Maybe a
Just Int
0 else forall a. Read a => [Char] -> Maybe a
readish [Char]
m

fromSchedule :: Schedule -> String
fromSchedule :: Schedule -> [Char]
fromSchedule (Schedule Recurrance
recurrance ScheduledTime
scheduledtime) = [[Char]] -> [Char]
unwords
	[ Recurrance -> [Char]
fromRecurrance Recurrance
recurrance
	, [Char]
"at"
	, ScheduledTime -> [Char]
fromScheduledTime ScheduledTime
scheduledtime
	]

toSchedule :: String -> Maybe Schedule
toSchedule :: [Char] -> Maybe Schedule
toSchedule = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] Schedule
parseSchedule

parseSchedule :: String -> Either String Schedule
parseSchedule :: [Char] -> Either [Char] Schedule
parseSchedule [Char]
s = do
	Recurrance
r <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"bad recurrance: " forall a. [a] -> [a] -> [a]
++ [Char]
recurrance) forall a b. b -> Either a b
Right
		([Char] -> Maybe Recurrance
toRecurrance [Char]
recurrance)
	ScheduledTime
t <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"bad time of day: " forall a. [a] -> [a] -> [a]
++ [Char]
scheduledtime) forall a b. b -> Either a b
Right
		([Char] -> Maybe ScheduledTime
toScheduledTime [Char]
scheduledtime)
	forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Recurrance -> ScheduledTime -> Schedule
Schedule Recurrance
r ScheduledTime
t
  where
	([[Char]]
rws, [[Char]]
tws) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== [Char]
"at") ([Char] -> [[Char]]
words [Char]
s)
	recurrance :: [Char]
recurrance = [[Char]] -> [Char]
unwords [[Char]]
rws
	scheduledtime :: [Char]
scheduledtime = [[Char]] -> [Char]
unwords [[Char]]
tws

prop_past_sane :: Bool
prop_past_sane :: Bool
prop_past_sane = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
	[ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast) ([(Day, Day)]
mplus1 forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1)
	, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneMonthPast)) (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap ([(Day, Day)]
mplus1 forall a. [a] -> [a] -> [a]
++ [(Day, Day)]
yplus1))
	, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast) [(Day, Day)]
yplus1
	, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {t} {t} {t}. (t -> t -> t) -> (t, t) -> t
checksout Day -> Day -> Bool
oneYearPast)) (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap [(Day, Day)]
yplus1)
	]
  where
	mplus1 :: [(Day, Day)]
mplus1 =   -- new date               old date, 1+ months before it
		[ (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 =   -- new date               old date, 1+ years before it
		[ (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)