Clean up DateExpr module

This commit is contained in:
Joscha 2017-12-11 18:56:11 +00:00
parent 28a46b4a86
commit cf6424b186

View file

@ -1,12 +1,16 @@
module DateExpr
( BoolExpr
, IntExpr
, parseBoolExpr
, firstMatchingDay
, evalBoolExpr
) where
import Data.List
import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.Easter
import Text.Parsec
data BoolExpr = BValue Bool
| BStatement DateStatement
@ -37,6 +41,13 @@ data SpecialDate = SJulianDay
| SMonthCount
| SEaster
{-
- Evaluating expressions
-}
firstMatchingDay :: BoolExpr -> Int -> Day -> Maybe Day
firstMatchingDay expr duration = find (evalBoolExpr expr) . take duration . iterate (addDays 1)
evalBoolExpr :: BoolExpr -> Day -> Bool
evalBoolExpr (BValue v) _ = v
evalBoolExpr (BStatement s) d = evalDateStatement s d
@ -71,6 +82,10 @@ evalSpecialDate SYearCount d = ((yearday d - 1) `div` 7) + 1
evalSpecialDate SMonthCount d = ((day d - 1) `div` 7) + 1
evalSpecialDate SEaster d = diffDays d $ orthodoxEaster $ year d
{-
- Helper functions for evaluation
-}
julian :: Day -> Integer
julian = flip diffDays (fromGregorian 1858 11 17)
@ -90,3 +105,10 @@ yearday :: Day -> Integer
yearday day = let (y,m,d) = toGregorian day
dayofyear = monthAndDayToDayOfYear (isLeapYear y) m d
in toInteger dayofyear
{-
- Parsing BoolExpr
-}
parseBoolExpr :: String -> Either ParseError BoolExpr
parseBoolExpr = undefined