From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- server/src/Util/Time.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) (limited to 'server/src/Util/Time.hs') diff --git a/server/src/Util/Time.hs b/server/src/Util/Time.hs index 3e0856d..4a29fcc 100644 --- a/server/src/Util/Time.hs +++ b/server/src/Util/Time.hs @@ -1,25 +1,22 @@ module Util.Time ( belongToCurrentMonth , belongToCurrentWeek - , timeToDay ) where -import Data.Time.Calendar +import Data.Time.Calendar (toGregorian) import Data.Time.Calendar.WeekDate (toWeekDate) import Data.Time.Clock (UTCTime, getCurrentTime) -import Data.Time.LocalTime + +import qualified Common.Util.Time as Time belongToCurrentMonth :: UTCTime -> IO Bool belongToCurrentMonth time = do - (timeYear, timeMonth, _) <- toGregorian <$> timeToDay time - (actualYear, actualMonth, _) <- toGregorian <$> (getCurrentTime >>= timeToDay) + (timeYear, timeMonth, _) <- toGregorian <$> Time.timeToDay time + (actualYear, actualMonth, _) <- toGregorian <$> (getCurrentTime >>= Time.timeToDay) return (actualYear == timeYear && actualMonth == timeMonth) belongToCurrentWeek :: UTCTime -> IO Bool belongToCurrentWeek time = do - (timeYear, timeWeek, _) <- toWeekDate <$> timeToDay time - (actualYear, actualWeek, _) <- toWeekDate <$> (getCurrentTime >>= timeToDay) + (timeYear, timeWeek, _) <- toWeekDate <$> Time.timeToDay time + (actualYear, actualWeek, _) <- toWeekDate <$> (getCurrentTime >>= Time.timeToDay) return (actualYear == timeYear && actualWeek == timeWeek) - -timeToDay :: UTCTime -> IO Day -timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time -- cgit v1.2.3