From 5375ad26dd78220185f1ffe05222250c06dc1a0c Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 21 Nov 2015 21:41:38 +0100
Subject: Get next week birthdays and send an empty mail for the moment
---
src/Model/Date.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 74 insertions(+)
create mode 100644 src/Model/Date.hs
(limited to 'src/Model/Date.hs')
diff --git a/src/Model/Date.hs b/src/Model/Date.hs
new file mode 100644
index 0000000..96c15e9
--- /dev/null
+++ b/src/Model/Date.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Model.Date
+ ( Date(..)
+ , getCurrentDate
+ , getNextWeek
+ , plusDays
+ , sameDayAndMonth
+ , isBeforeOrEqualDayAndMonth
+ , isAfterOrEqualDayAndMonth
+ , yearsGap
+ ) where
+
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.Time.LocalTime
+import qualified Data.Text as T
+
+import Time (formatCurrentLocale)
+
+data Date = Date
+ { day :: Int
+ , month :: Int
+ , year :: Int
+ } deriving (Eq, Show)
+
+getCurrentDate :: IO Date
+getCurrentDate = do
+ now <- getCurrentTime
+ timezone <- getCurrentTimeZone
+ let zoneNow = utcToLocalTime timezone now
+ return . dateFromDay $ localDay zoneNow
+
+getNextWeek :: IO (Date, Date)
+getNextWeek = do
+ currentDate <- getCurrentDate
+ currentDayNumberOfWeek <- (read . T.unpack <$> formatCurrentLocale "%u") :: IO Int
+ let begin = currentDate `plusDays` (8 - currentDayNumberOfWeek)
+ let end = begin `plusDays` 6
+ return (begin, end)
+
+plusDays :: Date -> Int -> Date
+plusDays (Date d m y) n =
+ dateFromDay . addDays (toInteger n) $ fromGregorian (toInteger y) m d
+
+dateFromDay :: Day -> Date
+dateFromDay dayTime =
+ let (y, m, d) = toGregorian dayTime
+ in Date d m (fromIntegral y)
+
+sameDayAndMonth :: Date -> Date -> Bool
+sameDayAndMonth d1 d2 =
+ ( day d1 == day d2
+ && month d1 == month d2
+ )
+
+isBeforeOrEqualDayAndMonth :: Date -> Date -> Bool
+isBeforeOrEqualDayAndMonth d1 d2 =
+ ( month d1 < month d2
+ || ( month d1 == month d2
+ && day d1 <= day d2
+ )
+ )
+
+isAfterOrEqualDayAndMonth :: Date -> Date -> Bool
+isAfterOrEqualDayAndMonth d1 d2 =
+ ( month d1 > month d2
+ || ( month d1 == month d2
+ && day d1 >= day d2
+ )
+ )
+
+yearsGap :: Date -> Date -> Int
+yearsGap d1 d2 = abs (year d2 - year d1)
--
cgit v1.2.3