Add Deadline and clean up date expressions

src/TaskMachine/DateExpr.hs

@@ -1,10 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | Parse and evaluate day-based expressions.
+-- An expression can be evaluated for any given day.
+--
+-- Evaluated expressions return 'Nothing' on impossible mathematical
+-- operations, for example division by 0.
+--
+-- For 'BoolExpr's, use the 'evalBoolExpr'' variant to automatically turn
+-- 'Nothing' into 'False'.
+
 module TaskMachine.DateExpr
   ( BoolExpr
   , parseBoolExpr
   , evalBoolExpr
+  , evalBoolExpr'
   , findNext
+  , findWithin
   , IntExpr
   , parseIntExpr
   , evalIntExpr
@@ -25,6 +36,7 @@ import           Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer     as L
 import           Text.Megaparsec.Expr
 
+-- | An expression that returns a 'Bool' when evaluated.
 data BoolExpr
   = BValue     Bool
   | BStatement DateStatement
@@ -43,6 +55,7 @@ data DateStatement
   | IsEaster -- same as: easter == 0
   deriving (Show)
 
+-- | An expression that returns an 'Integer' when evaluated.
 data IntExpr
   = IValue    Integer
   | ISDate    SpecialDate
@@ -66,22 +79,39 @@ data SpecialDate
   | SEaster
   deriving (Show)
 
+-- | Parse a 'BoolExpr' from a string.
 parseBoolExpr :: String -> Maybe BoolExpr
 parseBoolExpr = parseMaybe boolExpr
 
+-- | Parse an 'IntExpr' from a string.
 parseIntExpr :: String -> Maybe IntExpr
 parseIntExpr = parseMaybe intExpr
 
-findNext :: BoolExpr -> Day -> Int -> Maybe Day
+-- | Find the next day where the expression evaluates to @True@.
-findNext expr start duration =
+-- If no day could be found, returns @Nothing@.
+--
+-- This function uses 'evalBoolExpr'' to evaluate boolean expressions.
+findNext :: Day -> Int -> BoolExpr -> Maybe Day
+findNext start duration expr =
   let possibleDays = take duration $ iterate (addDays 1) start
-      checkDay = fromMaybe False . evalBoolExpr expr
+  in  find (evalBoolExpr' expr) possibleDays
-  in  find checkDay possibleDays
+
+-- | Returns a list of days where the expression evaluates to @True@.
+--
+-- This function uses 'evalBoolExpr'' to evaluate boolean expressions.
+findWithin :: Day -> Int -> BoolExpr -> [Day]
+findWithin start duration expr =
+  let possibleDays = take duration $ iterate (addDays 1) start
+  in  filter (evalBoolExpr' expr) possibleDays
 
 {-
  - Evaluating expressions
  -}
 
+-- | Evaluates a 'BoolExpr' for a given day.
+--
+-- Returns @Nothing@ if the expression contains any 'IntExpr'
+-- that evaluates to @Nothing@ (i. e. contains a mathematical impossibility).
 evalBoolExpr :: BoolExpr -> Day -> Maybe Bool
 evalBoolExpr (BValue v)     _ = pure v
 evalBoolExpr (BStatement s) d = pure $ evalDateStatement s d
@@ -93,6 +123,13 @@ evalBoolExpr (BEqual   a b) d = (==) <$> evalIntExpr a d <*> evalIntExpr b d
 evalBoolExpr (BGreater a b) d = (>)  <$> evalIntExpr a d <*> evalIntExpr b d
 evalBoolExpr (BLess    a b) d = (<)  <$> evalIntExpr a d <*> evalIntExpr b d
 
+-- | A variant of 'evalBoolExpr' that evaluates to False when the
+-- result of the evaluation is @Nothing@.
+--
+-- @'evalBoolExpr'' expr = 'fromMaybe' 'False' . 'evalBoolExpr' expr@
+evalBoolExpr' :: BoolExpr -> Day -> Bool
+evalBoolExpr' expr = fromMaybe False . evalBoolExpr expr
+
 evalDateStatement :: DateStatement -> Day -> Bool
 evalDateStatement IsLeapYear d = isLeapYear $ year d
 evalDateStatement IsWeekend  d = weekday d `elem` [6,7]
@@ -107,6 +144,9 @@ unlessSecondIsZero f a b d = do
   guard $ y /= 0
   return $ f x y
 
+-- | Evaluates an 'IntExpr' for a given day.
+--
+-- Returns a @Nothing@ when a division by 0 or modulo 0 occurs.
 evalIntExpr :: IntExpr -> Day -> Maybe Integer
 evalIntExpr (IValue v)      _ = pure v
 evalIntExpr (ISDate s)      d = pure $ evalSpecialDate s d

src/TaskMachine/Deadline.hs

@@ -0,0 +1,83 @@
+-- | Tasks and events can have one or multiple deadlines.
+--
+-- This module contains a representation for single deadlines,
+-- and some useful functions for calculating things with them.
+
+module TaskMachine.Deadline
+  ( Deadline(..)
+  , Duration
+  -- * Calculations
+  , relevant
+  , isRelevant
+  , nextDeadlines
+  , relevant'
+  , isRelevant'
+  , nextDeadlines'
+  ) where
+
+import           Data.Maybe
+
+import           Data.Time.Calendar
+
+import qualified TaskMachine.DateExpr as TM
+
+-- | Duration of a task or event in days.
+--
+-- A duration of 1 means one day.
+-- Because of this, 'Duration' values __must always be greater than 0__.
+type Duration = Int
+
+-- | A way to represent a deadline, either as a fixed date or using a formula.
+data Deadline
+  = DFixed Day (Maybe Duration)
+  | DExpression TM.BoolExpr Duration
+
+-- | Find the next date of the 'Deadline' that's important for a certain day.
+-- This returns a 'Just' when the day lies within the duration specified.
+--
+-- If no duration is specified in a 'DFixed' deadline, all days before the deadline,
+-- including the deadline itself, are important (i. e. the duration is infinite).
+relevant :: Day -> Deadline -> Maybe Day
+relevant today (DExpression expr duration) = TM.findNext today duration expr
+relevant today (DFixed day Nothing)
+  | diffDays day today >= 0 = Just day
+  | otherwise               = Nothing
+relevant today (DFixed day (Just duration))
+  | diff >= 0 && diff < toInteger duration = Just day
+  | otherwise                              = Nothing
+  where diff = diffDays day today
+
+-- | A version of 'relevant' modified to take a list of Deadlines.
+relevant' :: Day -> [Deadline] -> Maybe Day
+relevant' today deadlines =
+  let relevants = mapMaybe (relevant today) deadlines
+  in  case relevants of
+        []   -> Nothing
+        days -> Just $ minimum days
+
+
+
+-- | Whether the 'Deadline' is relevant on the current day or not.
+--
+-- This function works like 'relevant', only that the actual date calculated is irrelevant.
+--
+-- @'isRelevant' day = 'isJust' . 'relevant' day@
+isRelevant :: Day -> Deadline -> Bool
+isRelevant day = isJust . relevant day -- Hey, this even reads like English! :D
+
+-- | A version of 'isRelevant' modified to take a list of Deadlines.
+isRelevant' :: Day -> [Deadline] -> Bool
+isRelevant' day = any (isRelevant day)
+
+-- | Calculate all occurrences of this deadline within the duration given.
+nextDeadlines :: Day -> Duration -> Deadline -> [Day]
+nextDeadlines start duration (DFixed day _)
+  | diff >= 0 && diff < toInteger duration = [day]
+  | otherwise                              = []
+  where diff = diffDays day start
+nextDeadlines start duration (DExpression expr _) =
+  TM.findWithin start duration expr
+
+-- | A version of 'nextDeadlines' modified to take a list of Deadlines.
+nextDeadlines' :: Day -> Duration -> [Deadline] -> [Day]
+nextDeadlines' start duration = concatMap (nextDeadlines start duration)