diff options
Diffstat (limited to 'src/server/Utils')
| -rw-r--r-- | src/server/Utils/Time.hs | 38 |
1 files changed, 30 insertions, 8 deletions
diff --git a/src/server/Utils/Time.hs b/src/server/Utils/Time.hs index 170ab36..4a247e9 100644 --- a/src/server/Utils/Time.hs +++ b/src/server/Utils/Time.hs @@ -1,22 +1,44 @@ module Utils.Time ( belongToCurrentMonth + , belongToCurrentWeek , timeToDay + , monthToKey ) where -import Data.Time.Clock +import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.LocalTime import Data.Time.Calendar +import Data.Time.Calendar.WeekDate (toWeekDate) + +import Model.Message.Key (Key) +import qualified Model.Message.Key as K belongToCurrentMonth :: UTCTime -> IO Bool belongToCurrentMonth time = do - timeMonth <- dayMonth <$> timeToDay time - actualMonth <- dayMonth <$> (getCurrentTime >>= timeToDay) - return (timeMonth == actualMonth) + (timeYear, timeMonth, _) <- toGregorian <$> timeToDay time + (actualYear, actualMonth, _) <- toGregorian <$> (getCurrentTime >>= timeToDay) + return (actualYear == timeYear && actualMonth == timeMonth) + +belongToCurrentWeek :: UTCTime -> IO Bool +belongToCurrentWeek time = do + (timeYear, timeWeek, _) <- toWeekDate <$> timeToDay time + (actualYear, actualWeek, _) <- toWeekDate <$> (getCurrentTime >>= timeToDay) + return (actualYear == timeYear && actualWeek == timeWeek) timeToDay :: UTCTime -> IO Day timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time -dayMonth :: Day -> Int -dayMonth day = - let (_, month, _) = toGregorian day - in month +monthToKey :: Int -> Maybe Key +monthToKey 1 = Just K.January +monthToKey 2 = Just K.February +monthToKey 3 = Just K.March +monthToKey 4 = Just K.April +monthToKey 5 = Just K.May +monthToKey 6 = Just K.June +monthToKey 7 = Just K.July +monthToKey 8 = Just K.August +monthToKey 9 = Just K.September +monthToKey 10 = Just K.October +monthToKey 11 = Just K.November +monthToKey 12 = Just K.December +monthToKey _ = Nothing |