aboutsummaryrefslogtreecommitdiff
path: root/server/src/Util/Time.hs
blob: 3e0856db5d73c403a07ca007d113462677937bc4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
module Util.Time
  ( belongToCurrentMonth
  , belongToCurrentWeek
  , timeToDay
  ) where

import           Data.Time.Calendar
import           Data.Time.Calendar.WeekDate (toWeekDate)
import           Data.Time.Clock             (UTCTime, getCurrentTime)
import           Data.Time.LocalTime

belongToCurrentMonth :: UTCTime -> IO Bool
belongToCurrentMonth time = do
  (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